pascal/kolmck
1
0
Fork 0
Code Issues Releases Activity

3.01

Browse Source 
git-svn-id: https://svn.code.sf.net/p/kolmck/code@95 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07
This commit is contained in:
dkolmck
2010-12-09 06:20:06 +00:00
parent cba2748735
commit 25b148d10b
4 changed files with 186 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

68
KOL.pas
View File

@@ -14,7 +14,7 @@
Key Objects Library (C) 2000 by Kladov Vladimir.
****************************************************************
* VERSION 3.00.Z9
* VERSION 3.01
****************************************************************
K.O.L. - is a set of objects to create small programs
@@ -3006,6 +3006,7 @@ function ImageList_Merge(ImageList1: HImageList; Index1: Integer;
HImageList; stdcall;
function LoadBmp( Instance: Integer; Rsrc: PKOLChar; MasterObj: PObj ): HBitmap;
function LoadBmp32( Instance: Integer; Rsrc: PKOLChar; MasterObj: PObj ): HBitmap;
type
tagBitmap = Windows.TBitmap;
@@ -3324,7 +3325,7 @@ function CalcScanLineSize( Header: PBitmapInfoHeader ): Integer;
{* May be will be useful. }
var
DefaultPixelFormat: TPixelFormat = pf16bit;
DefaultPixelFormat: TPixelFormat = pf32bit; //pf16bit;
function LoadMappedBitmap( hInst: THandle; BmpResID: Integer; const Map: array of TColor )
: HBitmap;
@@ -33383,6 +33384,9 @@ function WndProcImageShow( Sender: PControl; var Msg: TMsg;
var PaintStruct: TPaintStruct;
IL: PImageList;
OldPaintDC: HDC;
{$IFDEF TEST_IL}
B: PBitmap;
{$ENDIF TEST_IL}
begin
Result := FALSE;
if (Msg.message = WM_PAINT) or (Msg.message = WM_PRINT) then
@@ -33394,6 +33398,14 @@ begin
IL := Sender.ImageListNormal;
if IL <> nil then
begin
IL.DrawingStyle := [ dsTransparent ];
{$IFDEF TEST_IL}
B := NewBitmap( 0, 0 );
B.Handle := IL.GetBitmap;
B.SaveToFile( GetStartDir + 'test_IL_show.bmp' );
B.ReleaseHandle;
B.Free;
{$ENDIF TEST_IL}
IL.Draw( Sender.fCurIndex, Sender.fPaintDC, Sender.fClientLeft, Sender.fClientTop );
Result := TRUE;
end;
@@ -48600,11 +48612,37 @@ begin
end;
function LoadBmp( Instance: Integer; Rsrc: PKOLChar; MasterObj: PObj ): HBitmap;
{$IFDEF LOAD_RLE_BMP_RSRCES}
var B: PBitmap;
R: PStream;
{$ENDIF}
begin
{$IFDEF LOAD_RLE_BMP_RSRCES}
R := NewMemoryStream;
Resource2Stream( R, hInstance, Rsrc, RT_BITMAP );
B := NewBitmap( 0, 0 );
R.Position := 0;
B.LoadFromStreamEx( R );
R.Free;
//B.SaveToFile( GetStartDir + 'test_loadbmp.bmp' );
Result := B.ReleaseHandle;
B.Free;
{$ELSE}
Result := LoadBitmap( Instance, Rsrc );
{$ENDIF}
MasterObj.Add2AutoFreeEx( TObjectMethod( MakeMethod( Pointer( Result ), @ FreeBmp ) ) );
end;
function LoadBmp32( Instance: Integer; Rsrc: PKOLChar; MasterObj: PObj ): HBitmap;
var B: PBitmap;
begin
B := NewBitmap( 0, 0 );
B.Handle := LoadBmp( Instance, Rsrc, MasterObj );
B.PixelFormat := pf32bit;
Result := B.ReleaseHandle;
B.Free;
end;
{ TImageList }
function TImageList.Add(Bmp, Msk: HBitmap): Integer;
@@ -48628,10 +48666,33 @@ begin
end;
function TImageList.AddMasked(Bmp: HBitmap; Color: TColor): Integer;
{$IFDEF TEST_IL}
var B: PBitmap;
{$ENDIF}
begin
Result := -1;
if not HandleNeeded then Exit;
{$IFDEF TEST_IL}
B := NewBitmap( 0, 0 );
B.Handle := Bmp;
B.PixelFormat := pf32bit;
B.SaveToFile( GetStartDir + 'test_Add_masked1.bmp' );
Bmp := B.ReleaseHandle;
B.Free;
{$ENDIF}
Result := ImageList_AddMasked( FHandle, Bmp, Color2RGB( Color ) );
{$IFDEF TEST_IL}
B := NewBitmap( 0, 0 );
B.Handle := GetBitmap;
B.SaveToFile( GetStartDir + 'test_Add_masked2.bmp' );
B.ReleaseHandle;
B.Free;
B := NewBitmap( 0, 0 );
B.Handle := GetMask;
B.SaveToFile( GetStartDir + 'test_Add_masked3.bmp' );
B.ReleaseHandle;
B.Free;
{$ENDIF}
end;
procedure TImageList.Clear;
@@ -54220,7 +54281,8 @@ begin
Clear;
if Value = 0 then Exit;
if (WinVer >= wvNT) and
(GetObject( Value, Sizeof( Dib ), @ Dib ) = Sizeof( Dib )) then
(GetObject( Value, Sizeof( Dib ), @ Dib ) = Sizeof( Dib ))
and (Dib.dsBmih.biBitCount > 8) then
begin
fHandle := Value;
fHandleType := bmDIB;

51
mckCtrls.pas
View File

@@ -65,8 +65,10 @@ type
FimageBitmap: Graphics.TBitmap;
FimageIcon: KOL.PIcon;
Fimage: TPicture;
FAllowBitmapCompression: Boolean;
procedure SetFlat(const Value: Boolean);
procedure Setimage(const Value: TPicture);
procedure SetAllowBitmapCompression(const Value: Boolean);
public
function TabStopByDefault: Boolean; override;
procedure FirstCreate; override;
@@ -126,6 +128,8 @@ type
property Flat: Boolean read FFlat write SetFlat; // only for not windowed ?
property WordWrap;
property LikeSpeedButton;
property AllowBitmapCompression: Boolean read FAllowBitmapCompression write SetAllowBitmapCompression
default TRUE;
public
procedure SetupConstruct_Compact; override;
function SupportsFormCompact: Boolean; override;
@@ -149,6 +153,7 @@ type
FBitBtnDrawMnemonic: Boolean;
FTextShiftY: Integer;
FTextShiftX: Integer;
FAllowBitmapCompression: Boolean;
procedure SetOptions(Value: TBitBtnOptions);
procedure SetGlyphBitmap(const Value: TBitmap);
procedure SetGlyphCount(Value: Integer);
@@ -163,6 +168,7 @@ type
procedure SetBitBtnDrawMnemonic(const Value: Boolean);
procedure SetTextShiftX(const Value: Integer);
procedure SetTextShiftY(const Value: Integer);
procedure SetAllowBitmapCompression(const Value: Boolean);
public
function TabStopByDefault: Boolean; override;
procedure FirstCreate; override;
@@ -225,6 +231,8 @@ type
property Brush;
property action;
property LikeSpeedButton;
property AllowBitmapCompression: Boolean read FAllowBitmapCompression write SetAllowBitmapCompression
default TRUE;
end;
@@ -1621,6 +1629,7 @@ type
FCompactCode: Boolean;
FAutosizeButtons: Boolean;
FNoSpaceForImages: Boolean;
FAllowBitmapCompression: Boolean;
procedure SetOptions(const Value: TToolbarOptions);
procedure Setbitmap(const Value: TBitmap);
procedure SetnoTextLabels(const Value: Boolean);
@@ -1651,6 +1660,7 @@ type
procedure SetCompactCode(const Value: Boolean);
procedure SetAutosizeButtons(const Value: Boolean);
procedure SetNoSpaceForImages(const Value: Boolean);
procedure SetAllowBitmapCompression(const Value: Boolean);
protected
FResBmpID: Integer;
fNewVersion: Boolean;
@@ -1755,6 +1765,8 @@ type
property AutosizeButtons: Boolean read FAutosizeButtons write SetAutosizeButtons;
property NoSpaceForImages: Boolean read FNoSpaceForImages write SetNoSpaceForImages;
property Autosize;
property AllowBitmapCompression: Boolean read FAllowBitmapCompression write SetAllowBitmapCompression
default TRUE;
end;
TKOLToolbarButtonsEditor = class( TStringProperty )
@@ -2155,6 +2167,7 @@ begin
TextAlign := taCenter;
VerticalAlign := vaCenter;
TabStop := True;
FAllowBitmapCompression := TRUE;
end;
procedure TKOLButton.CreateKOLControl(Recreating: boolean);
@@ -2511,7 +2524,7 @@ begin
begin
Rpt( 'Button has bitmap, generate resource', WHITE );
GenerateBitmapResource( FimageBitmap, ImageResourceName, ImageResourceName,
Updated );
Updated, AllowBitmapCompression );
end;
end;
@@ -2635,6 +2648,13 @@ begin
END;
end;
procedure TKOLButton.SetAllowBitmapCompression(const Value: Boolean);
begin
if FAllowBitmapCompression = Value then Exit;
FAllowBitmapCompression := Value;
Change;
end;
procedure TKOLButton.SetFlat(const Value: Boolean);
begin
FFlat := Value;
@@ -2773,7 +2793,7 @@ begin
else
SL.Add( '{$R ' + ImageResourceName + '.res}' );
GenerateBitmapResource( FimageBitmap, ImageResourceName, ImageResourceName,
Updated );
Updated, AllowBitmapCompression );
end;
end;
@@ -3693,6 +3713,7 @@ begin
TabStop := True;
fTextShiftX := 1;
fTextShiftY := 1;
FAllowBitmapCompression := TRUE;
end;
procedure TKOLBitBtn.CreateKOLControl(Recreating: boolean);
@@ -3845,7 +3866,8 @@ begin
RName := ParentKOLForm.FormName + '_' + Name;
Rpt( 'Prepare resource ' + RName + ' (' + UpperCase( Name + '_BITMAP' ) + ')',
WHITE );
GenerateBitmapResource( GlyphBitmap, UpperCase( Name + '_BITMAP' ), RName, fUpdated );
GenerateBitmapResource( GlyphBitmap, UpperCase( Name + '_BITMAP' ), RName,
fUpdated, AllowBitmapCompression );
SL.Add( Prefix + '{$R ' + RName + '.res}' );
end
else
@@ -3981,6 +4003,13 @@ begin
end;
end;
procedure TKOLBitBtn.SetAllowBitmapCompression(const Value: Boolean);
begin
if FAllowBitmapCompression = Value then Exit;
FAllowBitmapCompression := Value;
Change;
end;
procedure TKOLBitBtn.SetautoAdjustSize(const Value: Boolean);
begin
asm
@@ -4248,7 +4277,8 @@ begin
RName := ParentKOLForm.FormName + '_' + Name;
Rpt( 'Prepare resource ' + RName + ' (' + UpperCase( Name + '_BITMAP' ) +
')', WHITE );
GenerateBitmapResource( GlyphBitmap, UpperCase( Name + '_BITMAP' ), RName, fUpdated );
GenerateBitmapResource( GlyphBitmap, UpperCase( Name + '_BITMAP' ), RName, fUpdated,
AllowBitmapCompression );
if (KF <> nil) and KF.FormCompact and SupportsFormCompact then
begin
(SL as TFormStringList).OnAdd := nil;
@@ -11243,6 +11273,7 @@ begin
FTimer.OnTimer := Tick;
FTimer.Enabled := TRUE;
AllowPostPaint := True;
FAllowBitmapCompression := TRUE;
end;
procedure TKOLToolbar.DefineProperties(Filer: TFiler);
@@ -11729,7 +11760,8 @@ begin
Inc( N );
end;
end;
GenerateBitmapResource( Bmp, RsrcName, RsrcFile, fUpdated );
GenerateBitmapResource( Bmp, RsrcName, RsrcFile, fUpdated,
AllowBitmapCompression );
FINALLY
Bmp.Free;
END;
@@ -13273,7 +13305,7 @@ begin
Inc( N );
end;
end;
GenerateBitmapResource( Bmp, RsrcName, RsrcFile, fUpdated );
GenerateBitmapResource( Bmp, RsrcName, RsrcFile, fUpdated, AllowBitmapCompression );
FINALLY
Bmp.Free;
END;
@@ -13998,6 +14030,13 @@ begin
Change;
end;
procedure TKOLToolbar.SetAllowBitmapCompression(const Value: Boolean);
begin
if FAllowBitmapCompression = Value then Exit;
FAllowBitmapCompression := Value;
Change;
end;
{ TKOLToolbarButtonsEditor }
procedure TKOLToolbarButtonsEditor.Edit;

44
mckObjs.pas
View File

@@ -144,6 +144,8 @@ type
FColors: TImageListColors;
FMasked: Boolean;
FBkColor: TColor;
FAllowCompression: Boolean;
FForce32bit: Boolean;
procedure SetImgHeight(Value: Integer);
procedure SetImgWidth(Value: Integer);
procedure SetCount(const Value: Integer);
@@ -157,6 +159,8 @@ type
procedure SetBkColor(const Value: TColor);
function GetImageListHandle: THandle;
procedure AssignBitmapToKOLImgList;
procedure SetAllowCompression(const Value: Boolean);
procedure SetForce32bit(const Value: Boolean);
protected
FKOLImgList: PImageList;
procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override;
@@ -179,6 +183,9 @@ type
property Colors: TImageListColors read FColors write SetColors;
property Masked: Boolean read FMasked write SetMasked;
property BkColor: TColor read FBkColor write SetBkColor;
property AllowCompression: Boolean read FAllowCompression write SetAllowCompression
default TRUE;
property Force32bit: Boolean read FForce32bit write SetForce32bit;
end;
TKOLImageListEditor = class(TComponentEditor)
@@ -366,7 +373,7 @@ type KOLTPixelFormat = KOL.TPixelFormat;
function CountSystemColorsUsedInBitmap( Bmp: KOL.PBitmap; ColorList: KOL.PList ): KOLTPixelFormat;
//function SaveBitmap( Bitmap: TBitmap; const Path: String ): Boolean;
procedure GenerateBitmapResource( Bitmap: TBitmap; const RsrcName, FileName: String;
var Updated: Boolean );
var Updated: Boolean; AllowCompression: Boolean );
procedure GenerateIconResource( Icon: TIcon; const RsrcName, FileName: KOLString;
var Updated: Boolean );
procedure RemoveSelection( FD: IFormDesigner );
@@ -860,7 +867,7 @@ end;
// it is fast and has no restrictions on bitmap format at all.
procedure GenerateBitmapResource( Bitmap: TBitmap; const RsrcName, FileName:
String; var Updated: Boolean );
String; var Updated: Boolean; AllowCompression: Boolean );
var
HD1: packed record // First part of RESOURCEHEADER structure before
// Unicode string contained bitmap resource name
@@ -937,8 +944,10 @@ begin
Mem := NewMemoryStream;
MemRLE := NewMemoryStream;
TRY
KOLBmp.CoreSaveToStream( Mem );
if N > 0 then
if AllowCompression then
KOLBmp.CoreSaveToStream( Mem )
else KOLBmp.SaveToStream( Mem );
if (N > 0) and AllowCompression then
begin
if KOLPF = KOL.pf1bit then
KOLBmp.PixelFormat := KOL.pf4bit;
@@ -1449,6 +1458,7 @@ begin
NeedFree := False; // ImageList in KOL destroyes self when its parent
// control is destroyed - automatically.
fCreationPriority := 10;
FAllowCompression := TRUE;
end;
destructor TKOLImageList.Destroy;
@@ -1573,10 +1583,17 @@ begin
{P}SL.Add( ' L(0) C1 LoadStr ''' + RsrcName + ''' #0 LoadHInstance' +
' LoadBmp<3> RESULT C2 TImageList.Add<3>' );
//Rpt( 'Generating resource: ' + ProjectSourcePath + RsrcFile + '.res' );
GenerateBitmapResource( FBitmap, RsrcName, RsrcFile, fUpdated );
GenerateBitmapResource( FBitmap, RsrcName, RsrcFile, fUpdated, AllowCompression );
end;
end;
procedure TKOLImageList.SetAllowCompression(const Value: Boolean);
begin
if FAllowCompression = Value then Exit;
FAllowCompression := Value;
Change;
end;
procedure TKOLImageList.SetBitmap(const Value: TBitmap);
{$IFDEF _D2}
var KOLBmp: KOL.PBitmap;
@@ -1724,6 +1741,13 @@ begin
Change;
end;
procedure TKOLImageList.SetForce32bit(const Value: Boolean);
begin
if FForce32bit = Value then Exit;
FForce32bit := Value;
Change;
end;
procedure TKOLImageList.SetImgHeight(Value: Integer);
var I: Integer;
begin
@@ -1861,7 +1885,7 @@ const Booleans: array[ Boolean ] of String = ( 'False', 'True' );
const ColorsValues: array[ TImageListColors ] of String = ( 'ilcColor', 'ilcColor4',
'ilcColor8', 'ilcColor16', 'ilcColor24', 'ilcColor32', 'ilcColorDDB',
'ilcDefault' );
var RsrcName, RsrcFile: String;
var RsrcName, RsrcFile, is32: String;
begin
asm
jmp @@e_signature
@@ -1890,6 +1914,8 @@ begin
if FImgHeight <> 32 then
SL.Add( Prefix + ' ' + AName + '.ImgHeight := ' + IntToStr( FImgHeight ) + ';' );
end;
is32 := '';
if Force32bit then is32 := '32';
if (FBitmap.Width <> 0) and (FBitmap.Height <> 0) then
begin
if (FImgHeight = 32) and (FImgWidth <> FImgHeight) then
@@ -1898,15 +1924,15 @@ begin
RsrcFile := ParentKOLForm.FormName + '_' + Name;
SL.Add( Prefix + ' {$R ' + RsrcFile + '.res}' );
if Masked then
SL.Add( Prefix + AName + '.AddMasked( LoadBmp( hInstance, ''' +
SL.Add( Prefix + AName + '.AddMasked( LoadBmp' + is32 + '( hInstance, ''' +
RsrcName + ''', ' +
AName + ' ), ' + Color2Str( TransparentColor ) + ' );' )
else
SL.Add( Prefix + AName + '.Add( LoadBmp( hInstance, ''' +
SL.Add( Prefix + AName + '.Add( LoadBmp' + is32 + '( hInstance, ''' +
RsrcName + ''', ' +
AName + ' ), 0 );' );
//Rpt( 'Generating resource: ' + ProjectSourcePath + RsrcFile + '.res' );
GenerateBitmapResource( FBitmap, RsrcName, RsrcFile, fUpdated );
GenerateBitmapResource( FBitmap, RsrcName, RsrcFile, fUpdated, AllowCompression );
end;
end;

63
mirror.pas
View File

@@ -19,7 +19,7 @@ mmmmm mmmmm mmmmm cccccccccccc kkkkk kkkkk
Key Objects Library (C) 1999 by Kladov Vladimir.
KOL Mirror Classes Kit (C) 2000 by Kladov Vladimir.
********************************************************
* VERSION 3.00.X
* VERSION 3.01
********************************************************
}
unit mirror;
@@ -473,9 +473,11 @@ type
FColor: TColor;
FBitmap: TBitmap;
fChangingNow: Boolean;
FAllowBitmapCompression: Boolean;
procedure SetBitmap(const Value: TBitmap);
procedure SetBrushStyle(const Value: TBrushStyle);
procedure SetColor(const Value: TColor);
procedure SetAllowBitmapCompression(const Value: Boolean);
protected
procedure GenerateCode( SL: TStrings; const AName: String );
procedure P_GenerateCode( SL: TStrings; const AName: String );
@@ -488,6 +490,8 @@ type
property Color: TColor read FColor write SetColor;
property BrushStyle: TBrushStyle read FBrushStyle write SetBrushStyle;
property Bitmap: TBitmap read FBitmap write SetBitmap;
property AllowBitmapCompression: Boolean read FAllowBitmapCompression write SetAllowBitmapCompression
default TRUE;
end;
@@ -1432,6 +1436,7 @@ type
FMenuBreak: TMenuBreak;
FTag: Integer;
Faction: TKOLAction;
FAllowBitmapCompression: Boolean;
procedure SetBitmap(Value: TBitmap);
procedure SetCaption(const Value: TDelphiString);
function GetCount: Integer;
@@ -1459,6 +1464,7 @@ type
procedure SetMenuBreak(const Value: TMenuBreak);
procedure SetTag(const Value: Integer);
procedure Setaction(const Value: TKOLAction);
procedure SetAllowBitmapCompression(const Value: Boolean);
protected
FDestroying: Boolean;
FSubItemCount: Integer;
@@ -1548,6 +1554,8 @@ type
property WindowMenu: Boolean read FWindowMenu write SetWindowMenu;
property HelpContext: Integer read FHelpContext write SetHelpContext;
property action: TKOLAction read Faction write Setaction;
property AllowBitmapCompression: Boolean read FAllowBitmapCompression write SetAllowBitmapCompression
default TRUE;
end;
{$IFDEF _D2orD3}
{$WARNINGS ON}
@@ -24091,6 +24099,7 @@ begin
else
Items.Insert( I, Self );
end;
FAllowBitmapCompression := TRUE;
end;
destructor TKOLMenuItem.Destroy;
@@ -24279,12 +24288,7 @@ begin
Change;
end;
procedure TKOLMenuItem.
{$IFDEF _D2009orHigher}
SetCaption(const Value: WideString);
{$ELSE}
SetCaption(const Value: String);
{$ENDIF}
procedure TKOLMenuItem.SetCaption(const Value: TDelphiString);
begin
asm
jmp @@e_signature
@@ -24824,11 +24828,7 @@ begin
end;
procedure TKOLMenuItem.SetupTemplate(SL: TStringList; FirstItem: Boolean);
{$IFDEF _D2009orHigher}
procedure Add2SL( const S: WideString );
{$ELSE}
procedure Add2SL( const S: String );
{$ENDIF}
procedure Add2SL( const S: TDelphiString );
begin
if Length( SL[ SL.Count - 1 ] + S ) > 64 then
SL.Add( ' ' + S )
@@ -25104,7 +25104,7 @@ begin
MenuName + ' );' );
SL.Add( ' {$R ' + RsrcName + '.res}' );
GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName + '_BITMAP' ), RsrcName,
MenuComponent.fUpdated );
MenuComponent.fUpdated, AllowBitmapCompression );
end;
if (BitmapChecked <> nil) and (bitmapChecked.Width <> 0) and (bitmapChecked.Height <> 0) then
begin
@@ -25114,7 +25114,7 @@ begin
MenuName + ' );' );
SL.Add( ' {$R ' + RsrcName + '.res}' );
GenerateBitmapResource( bitmapChecked, UPPERCASE( RsrcName ), RsrcName,
MenuComponent.fUpdated );
MenuComponent.fUpdated, AllowBitmapCompression );
end;
if (BitmapItem <> nil) and (bitmapItem.Width <> 0) and (bitmapItem.Height <> 0) then
begin
@@ -25124,7 +25124,7 @@ begin
MenuName + ' );' );
SL.Add( ' {$R ' + RsrcName + '.res}' );
GenerateBitmapResource( bitmapItem, UPPERCASE( RsrcName ), RsrcName,
MenuComponent.fUpdated );
MenuComponent.fUpdated, AllowBitmapCompression );
end;
//-if FownerDraw then
//- SL.Add( ' ' + MenuName + '.Items[ ' + IntToStr( ItemIndex ) +
@@ -25638,7 +25638,7 @@ begin
SL.Add( ' {$R ' + RsrcName + '.res}' ); //todo: � �-����������� ��������� ���
// ����� ������ � ������������� ����� ����!!!!!!
GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName + '_BITMAP' ), RsrcName,
MenuComponent.fUpdated );
MenuComponent.fUpdated, AllowBitmapCompression );
end;
if (BitmapChecked <> nil) and (bitmapChecked.Width <> 0) and (bitmapChecked.Height <> 0) then
begin
@@ -25654,7 +25654,7 @@ begin
' TMenu_.SetbitmapChecked<2>' );
SL.Add( ' {$R ' + RsrcName + '.res}' );
GenerateBitmapResource( bitmapChecked, UPPERCASE( RsrcName ), RsrcName,
MenuComponent.fUpdated );
MenuComponent.fUpdated, AllowBitmapCompression );
end;
if (BitmapItem <> nil) and (bitmapItem.Width <> 0) and (bitmapItem.Height <> 0) then
begin
@@ -25670,7 +25670,7 @@ begin
' TMenu_.SetbitmapItem<2>' );
SL.Add( ' {$R ' + RsrcName + '.res}' );
GenerateBitmapResource( bitmapItem, UPPERCASE( RsrcName ), RsrcName,
MenuComponent.fUpdated );
MenuComponent.fUpdated, AllowBitmapCompression );
end;
(**************** -> P_SetupAttributesLast
if FownerDraw then
@@ -25816,6 +25816,13 @@ begin
' TMenu_.SetownerDraw<2>' );
end;
procedure TKOLMenuItem.SetAllowBitmapCompression(const Value: Boolean);
begin
if FAllowBitmapCompression = Value then Exit;
FAllowBitmapCompression := Value;
Change;
end;
{ TKOLMenuEditor }
procedure TKOLMenuEditor.Edit;
@@ -26792,6 +26799,7 @@ begin
FOwner := AOwner;
FBitmap := TBitmap.Create;
FColor := clBtnFace;
FAllowBitmapCompression := TRUE;
end;
destructor TKOLBrush.Destroy;
@@ -26837,7 +26845,8 @@ begin
begin
RsrcName := (FOwner as TKOLForm).Owner.Name + '_' +
(FOwner as TKOLForm).Name + '_BRUSH_BMP';
GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated );
GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated,
AllowBitmapCompression );
if KF.FormCompact then
begin
(SL as TFormStringList).OnAdd := nil;
@@ -26884,7 +26893,8 @@ begin
begin
RsrcName := (FOwner as TKOLCustomControl).ParentForm.Name + '_' +
(FOwner as TKOLCustomControl).Name + '_BRUSH_BMP';
GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated );
GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated,
AllowBitmapCompression );
if (KF <> nil) and KF.FormCompact then
begin
(SL as TFormStringList).OnAdd := nil;
@@ -26947,7 +26957,8 @@ begin
(FOwner as TKOLForm).Name + '_BRUSH_BMP';
SL.Add( ' {$R ' + RsrcName + '.res}' );
//todo: (PCompiler) copy {$R ...} from Pcode to asm as is!
GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated );
GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated,
AllowBitmapCompression );
//SL.Add( ' ' + AName + '.Brush.BrushBitmap := LoadBmp( hInstance, ''' + UpperCase( RsrcName )
// + ''', Result );' );
ProvideBrushInStack;
@@ -26983,7 +26994,8 @@ begin
RsrcName := (FOwner as TKOLCustomControl).ParentForm.Name + '_' +
(FOwner as TKOLCustomControl).Name + '_BRUSH_BMP';
SL.Add( ' {$R ' + RsrcName + '.res}' );
GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated );
GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated,
AllowBitmapCompression );
//SL.Add( ' ' + AName + '.Brush.BrushBitmap := LoadBmp( hInstance, ''' + UpperCase( RsrcName )
// + ''', Result );' );
{P}SL.Add( ' LoadAnsiStr ' + P_String2Pascal( UpperCase( RsrcName ) ) );
@@ -26997,6 +27009,13 @@ begin
{P}SL.Add( ' DEL // Brush ' );
end;
procedure TKOLBrush.SetAllowBitmapCompression(const Value: Boolean);
begin
if FAllowBitmapCompression = Value then Exit;
FAllowBitmapCompression := Value;
Change;
end;
procedure TKOLBrush.SetBitmap(const Value: TBitmap);
begin
FBitmap.Assign(Value);