From 83ed683a62693521f130bd1ee8b52a32c53ba676 Mon Sep 17 00:00:00 2001 From: dkolmck Date: Thu, 18 Mar 2010 18:35:39 +0000 Subject: [PATCH] fix 32dib TBitmap fix TIcon wipe classes ... git-svn-id: https://svn.code.sf.net/p/kolmck/code@51 91bb2d04-0c0c-4d2d-88a5-bbb6f4c1fa07 --- KOL.pas | 1328 +++++---------------------------------------------- KOLDEF.inc | 28 +- KOL_ASM.inc | 8 + KOLadd.pas | 25 - 4 files changed, 133 insertions(+), 1256 deletions(-) diff --git a/KOL.pas b/KOL.pas index cb90ec0..2d67b1e 100644 --- a/KOL.pas +++ b/KOL.pas @@ -253,8 +253,6 @@ unit KOL; {-} USE_GRUSH - to use ToGRush.pas unit, which provides automatic redirection of the most cintrols creation functions to the KOLGRushControls.pas. - (USE_CONSTRUCTORS - to use constructors like in VCL. Note: this option is - not carefully tested!) TLIST_FAST - very fast implementation of TList (for coast of some additional code). DFLT_TLIST_NOUSE_BLOCKS - for TLIST_FAST: by default, do not make all TList @@ -572,23 +570,23 @@ var {$ERROR 'Delphi 2 cannot compile with UNICODE_CTRLS defined!'} {$ENDIF} const - SizeOfKOLChar = SizeOf(WideChar); + SizeOfKOLChar = SizeOf(WideChar); type - KOLString = WideString; + KOLString = WideString; KOL_String = type WideString; - KOLChar = type WideChar; - PKOLChar = PWideChar; + KOLChar = type WideChar; + PKOLChar = PWideChar; PKOL_Char = type PWideChar; {$ELSE} const - SizeOfKOLChar = SizeOf(AnsiChar); + SizeOfKOLChar = SizeOf(AnsiChar); type - KOLString = AnsiString; + KOLString = AnsiString; KOL_String = type AnsiString; - KOLChar = type AnsiChar; - PKOLChar = PAnsiChar; + KOLChar = type AnsiChar; + PKOLChar = PAnsiChar; PKOL_Char = type PAnsiChar; {$IFDEF ASM_VERSION} {$DEFINE ASM_UNICODE} @@ -828,9 +826,6 @@ type procedure SetCapacity( Value: Integer ); function Get( Idx: Integer ): Pointer; procedure Put( Idx: Integer; Value: Pointer ); - {$IFDEF USE_CONSTRUCTORS} - procedure Init; virtual; - {$ENDIF} protected {$IFDEF TLIST_FAST} fUseBlocks: Boolean; @@ -1027,7 +1022,6 @@ type {* Waits (infinitively) until thead will be finished. } function WaitForTime( T: DWORD ): Integer; {* Waits (T milliseconds) until thead will be finished. } - property Handle: THandle read FHandle; {* Thread handle. It is created immediately when object is created (using NewThread). } @@ -1046,7 +1040,6 @@ type THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_TIME_CRITICAL. } property Data : Pointer read FData write FData; {* Custom data pointer. Use it for Youe own purpose. } - property OnExecute: TOnThreadExecute read FOnExecute write FOnExecute; {* Is called, when Execute is starting. } property OnSuspend: TObjectMethod read FOnSuspend write FOnSuspend; @@ -1059,11 +1052,6 @@ type procedure SynchronizeEx( Method: TThreadMethodEx; Param: Pointer ); {* Call it to execute given method in main thread context, with a given parameter. Applet variable must exist for that time. Param must not be nil. } - {$IFDEF USE_CONSTRUCTORS} - constructor ThreadCreate; - constructor ThreadCreateEx( const Proc: TOnThreadExecute ); - {$ENDIF USE_CONSTRUCTORS} - property AutoFree: Boolean read F_AutoFree write F_AutoFree; {* Set this property to true to provide automatic destroying of thread object when its executing is finished. } @@ -2855,9 +2843,6 @@ type other images from the image list). These overalay images can be used in listview and treeview as overlaying images (up to four masks at the same time). } - {$IFDEF USE_CONSTRUCTORS} - constructor CreateImageList( POwner: Pointer ); - {$ENDIF USE_CONSTRUCTORS} end; //[END OF TImageList DEFINITION] @@ -3821,7 +3806,7 @@ type //[Create Window STRUCTURES] TCreateParams = packed record {* Record to pass it through CreateSubClass method. } - Caption: PKOLChar; + Caption: PKOLChar; Style: cardinal; ExStyle: cardinal; X, Y: Integer; @@ -3834,16 +3819,16 @@ type TCreateWndParams = packed Record ExStyle: DWORD; - WinClassName: PKOLChar; - Caption: PKOLChar; + WinClassName: PKOLChar; + Caption: PKOLChar; Style: DWORD; X, Y, Width, Height: Integer; WndParent: HWnd; Menu: HMenu; Inst: THandle; Param: Pointer; - WinClsNamBuf: array[ 0..63 ] of KOLChar; - WindowClass: TWndClass; + WinClsNamBuf: array[ 0..63 ] of KOLChar; + WindowClass: TWndClass; end; //[COMMAND ACTIONS TYPE FOR DIFFERENT CONTROLS] @@ -4644,8 +4629,8 @@ type fGetCaption: TGetCaption; fSetCaption: TSetCaption; {$ENDIF _X_} - function GetCaption: KOLString; - procedure SetCaption( const Value: KOLString ); + function GetCaption: KOLString; + procedure SetCaption( const Value: KOLString ); {$IFDEF GDI} procedure SetWindowState( Value: TWindowState ); @@ -5194,7 +5179,7 @@ type {* Returns Icon property. By default, if it is not set, returns Icon property of an Applet. } - procedure CreateSubclass( var Params: TCreateParams; ControlClassName: PKOLChar ); + procedure CreateSubclass( var Params: TCreateParams; ControlClassName: PKOLChar ); {* Can be used in descending classes to subclass window with given standard Windows ControlClassName - must be called after creating Params but before CreateWindow. Usually it is called @@ -8701,51 +8686,6 @@ type property AnchorBottom: Boolean read fAnchorBottom write SetAnchorBottom; function Anchor( aLeft, aTop, aRight, aBottom: Boolean ): PControl; public - {$IFDEF USE_CONSTRUCTORS} - //------------------------------------------------------------ - // constructors here: - constructor CreateWindowed( AParent: PControl; AClassName: PKOLChar; ACtl3D: Boolean ); - constructor CreateApplet( const ACaption: AnsiString ); - constructor CreateForm( AParent: PControl; const ACaption: AnsiString ); - constructor CreateControl( AParent: PControl; AClassName: PAnsiChar; AStyle: DWORD; - ACtl3D: Boolean; Actions: PCommandActions ); - constructor CreateButton( AParent: PControl; const ACaption: AnsiString ); - constructor CreateBitBtn( AParent: PControl; const ACaption: AnsiString; - AOptions: TBitBtnOptions; ALayout: TGlyphLayout; AGlyphBitmap: HBitmap; - AGlyphCount: Integer); - constructor CreateLabel( AParent: PControl; const ACaption: AnsiString ); - constructor CreateWordWrapLabel( AParent: PControl; const ACaption: AnsiString ); - constructor CreateLabelEffect( AParent: PControl; ACaption: AnsiString; AShadowDeep: Integer ); - constructor CreatePaintBox( AParent: PControl ); - constructor CreateGradientPanel( AParent: PControl; AColor1, AColor2: TColor ); - constructor CreateGradientPanelEx( AParent: PControl; AColor1, AColor2: TColor; - AStyle: TGradientStyle; ALayout: TGradientLayout ); - constructor CreateGroupbox( AParent: PControl; const ACaption: AnsiString ); - constructor CreateCheckbox( AParent: PControl; const ACaption: AnsiString ); - constructor CreateRadiobox( AParent: PControl; const ACaption: AnsiString ); - constructor CreateEditbox( AParent: PControl; AOptions: TEditOptions ); - constructor CreatePanel( AParent: PControl; AStyle: TEdgeStyle ); - constructor CreateSplitter( AParent: PControl; AMinSizePrev, AMinSizeNext: Integer; - EdgeStyle: TEdgeStyle ); - constructor CreateListbox( AParent: PControl; AOptions: TListOptions ); - constructor CreateCombobox( AParent: PControl; AOptions: TComboOptions ); - constructor CreateCommonControl( AParent: PControl; AClassName: PAnsiChar; AStyle: DWORD; - ACtl3D: Boolean; Actions: PCommandActions ); - constructor CreateRichEdit( AParent: PControl; AOptions: TEditOptions ); - constructor CreateRichEdit1( AParent: PControl; AOptions: TEditOptions ); - constructor CreateProgressbar( AParent: PControl ); - constructor CreateProgressbarEx( AParent: PControl; AOptions: TProgressbarOptions ); - constructor CreateListView( AParent: PControl; AStyle: TListViewStyle; AOptions: TListViewOptions; - AImageListSmall, AImageListNormal, AImageListState: PImageList ); - constructor CreateTreeView( AParent: PControl; AOptions: TTreeViewOptions; - AImgListNormal, AImgListState: PImageList ); - constructor CreateTabControl( AParent: PControl; ATabs: array of String; - AOptions: TTabControlOptions; AImgList: PImageList; AImgList1stIdx: Integer ); - constructor CreateToolbar( AParent: PControl; AAlign: TControlAlign; AOptions: TToolbarOptions; - ABitmap: HBitmap; AButtons: array of PChar; - ABtnImgIdxArray: array of Integer ); - {$ENDIF USE_CONSTRUCTORS} - {$IFDEF USE_CUSTOMEXTENSIONS} {$I CUSTOM_TCONTROL_EXTENSION.inc} {$ENDIF} @@ -8754,9 +8694,7 @@ type // methods and properties. This provides You with capability to extend // TControl implementing another kinds of visual controls without deriving // new descendant objects from TControl. This way is provided to avoid too - // large grow of executable size. You also can derive your own controls - // from TControl using standard OOP capabilities. In such case an option - // USE_CONSTRUCTORS should be turned on (see it at the start of this unit). + // large grow of executable size. // If You choose this "flat" model of extending the TControl with your // own properties, fieds, methods, events, etc. You should provide three // inc-files: CUSTOM_TCONTROL_EXTENSION.inc, containing such definitions @@ -8768,7 +8706,6 @@ type // to use the same naming rule for all of You. Name your fields, properies, etc. // using a form idx_SomeName, where idx is a prefix, containing several // (at least one) letters and digits. E.g. ZK65_OnSomething. - protected fParentCoordX: Integer; fParentCoordY: Integer; @@ -10513,7 +10450,8 @@ type {* Returns TDateTimeRange from two TDateTime bounds. } //[Integer FUNCTIONS DECLARATIONS] - procedure Swap( var X, Y: Integer ); + procedure Swap( var X, Y: Integer ); overload; + procedure Swap(var X, Y: Byte); overload; {* exchanging values } function Min( X, Y: Integer ): Integer; {* minimum of two integers } @@ -12132,8 +12070,8 @@ type procedure SetItemChecked( Item : Integer; Value : Boolean ); function GetItemBitmap(Idx: Integer): HBitmap; procedure SetItemBitmap(Idx: Integer; const Value: HBitmap); - function GetItemText(Idx: Integer): KOLString; - procedure SetItemText(Idx: Integer; const Value: KOLString); + function GetItemText(Idx: Integer): KOLString; + procedure SetItemText(Idx: Integer; const Value: KOLString); function GetItemEnabled(Idx: Integer): Boolean; procedure SetItemEnabled(Idx: Integer; const Value: Boolean); function GetItemVisible(Idx: Integer): Boolean; @@ -12352,7 +12290,7 @@ type only - for checked menu items default checkmark bitmap is used). } procedure AssignBitmaps( StartIdx: Integer; Bitmaps: array of HBitmap ); {* Can be used to assign bitmaps to several menu items during one call. } - property ItemText[ Idx: Integer ]: KOLString read GetItemText write SetItemText; + property ItemText[ Idx: Integer ]: KOLString read GetItemText write SetItemText; {* This property allows to get / modify menu item text at run time. } property ItemEnabled[ Idx: Integer ]: Boolean read GetItemEnabled write SetItemEnabled; {* Controls enabling / disabling menu items. Disabled menu items are @@ -12378,11 +12316,11 @@ type {* Retrieves submenu item dynamically. See also SubMenu property. } // by Sergey Shisminzev: - function AddItem(ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions): Integer; + function AddItem(ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions): Integer; {* Adds menu item dynamically. Returns ID of the added item. } - function InsertItem(InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions): Integer; + function InsertItem(InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions): Integer; {* Inserts menu item before an item with ID, given by InsertBefore parameter. } - function InsertItemEx(InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions; + function InsertItemEx(InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions; ByPosition: Boolean): Integer; {* Inserts menu item by command or by position, dependant on ByPosition parameter } procedure RedrawFormMenuBar; @@ -13241,7 +13179,7 @@ function CrackStack_MapInFile( const MapFileName: KOLString; Max_length: Integer no enough data). } {$IFDEF _D2006orHigher} - {$I MCKfakeClasses200x.inc} // Dufa + {$I MCKfakeClasses200x.inc} // Dufa {$ENDIF} //[IMPLEMENTATION] implementation @@ -13851,6 +13789,7 @@ procedure _SetDIBPixels1bit( Bmp: PBitmap; X, Y: Integer; Value: TColor ); forwa procedure _SetDIBPixelsPalIdx( Bmp: PBitmap; X, Y: Integer; Value: TColor ); forward; procedure _SetDIBPixels16bit( Bmp: PBitmap; X, Y: Integer; Value: TColor ); forward; procedure _SetDIBPixelsTrueColor( Bmp: PBitmap; X, Y: Integer; Value: TColor ); forward; +procedure _SetDIBPixelsTrueColorWithAlpha(Bmp: PBitmap; X, Y: Integer; Value: TColor); forward; procedure FillBmpWithBkColor( Bmp: PBitmap; DC2: HDC; oldWidth, oldHeight: Integer ); forward; procedure DetachBitmapFromCanvas( Sender: PBitmap ); forward; function ColorBits( ColorsCount : Integer ) : Integer; forward; @@ -14554,7 +14493,7 @@ begin end; //[procedure Swap] -procedure Swap( var X, Y: Integer ); +procedure Swap( var X, Y: Integer ); overload; {$IFDEF F_P} var Tmp: Integer; begin @@ -14571,6 +14510,16 @@ end; //[END Swap] {$ENDIF F_P/DELPHI} +//[procedure Swap] +procedure Swap(var X, Y: Byte); overload; +var + T: Byte; +begin + T := X; + X := Y; + Y := T; +end; + //[function Min] function Min( X, Y: Integer ): Integer; asm @@ -15186,29 +15135,6 @@ end; {$ENDIF} {$ENDIF} -{$IFDEF USE_CONSTRUCTORS} -procedure TList.Init; -begin - {$IFDEF _D2orD3} - inherited; - {$ENDIF} - fAddBy := 4; - {$IFDEF TLIST_FAST} - {$IFNDEF DFLT_TLIST_NOUSE_BLOCKS} // for debug only - fUseBlocks := TRUE; - {$ENDIF} - {$ENDIF} -end; - -//[function NewList] -function NewList: PList; -begin - New( Result, Create ); - //Result.fAddBy := 4; -end; -//[END NewList] - -{$ELSE not_USE_CONSTRUCTORS} //[function NewList] function NewList: PList; begin @@ -15223,7 +15149,6 @@ begin {$ENDIF} end; //[END NewList] -{$ENDIF USE_CONSTRUCTORS} //[procedure TList.Init] {$IFDEF _D4orHigher} @@ -16764,7 +16689,8 @@ end; function Color2RGB( Color: TColor ): TColor; begin if Color < 0 then - Result := GetSysColor(Color and $7F) else + Result := GetSysColor(Color and $7F) + else Result := Color; end; {$ENDIF ASM_VERSION} @@ -24730,14 +24656,6 @@ begin Result := Thread.Execute; end; -{$IFDEF USE_CONSTRUCTORS} -//[function NewThread] -function NewThread: PThread; -begin - new( Result, ThreadCreate ); -end; -//[END NewThread] -{$ELSE not_USE_CONSTRUCTORS} //* //[function NewThread] function NewThread: PThread; @@ -24761,15 +24679,6 @@ begin {$ENDIF} end; //[END NewThread] -{$ENDIF USE_CONSTRUCTORS} - -{$IFDEF USE_CONSTRUCTORS} -//[function NewThreadEx] -function NewThreadEx( const Proc: TOnThreadExecute ): PThread; -begin - new( Result, ThreadCreateEx( Proc ) ); -end; -{$ELSE not_USE_CONSTRUCTORS} //[FUNCTION NewThreadEx] {$IFDEF ASM_!VERSION} @@ -24798,8 +24707,6 @@ end; {$ENDIF ASM_VERSION} //[END NewThreadEx] -{$ENDIF USE_CONSTRUCTORS} - //[function NewThreadAutoFree] function NewThreadAutoFree( const Proc: TOnThreadExecute ): PThread; begin @@ -27200,7 +27107,7 @@ begin {$IFNDEF UNICODE_CTRLS} Result := SetMenuItemInfo( H, FId, FALSE, Windows.PMenuitemInfo( @ MII )^ ); {$ELSE} - Result := SetMenuItemInfoW( H, FId, FALSE, Windows.PMenuitemInfoW( @ MII )^ ); + Result := SetMenuItemInfoW( H, FId, FALSE, Windows.PMenuitemInfoW( @ MII )^ ); {$ENDIF} if Result and ((FParentMenu = nil) or (FParentMenu.FParentMenu = nil)) then {YS} RedrawFormMenuBar; @@ -27212,7 +27119,7 @@ begin if not FIsSeparator then begin if FBmpItem = 0 then - MII.dwTypeData := PKOLChar( FCaption ) + MII.dwTypeData := PKOLChar( FCaption ) else MII.dwTypeData := Pointer( FBmpItem ); MII.cch := Length( FCaption )*SizeOfKOLChar; @@ -27580,8 +27487,8 @@ begin if not FIsSeparator then begin MII.fType := MII.fType or MFT_STRING; - MII.dwTypeData := PKOLChar( FCaption ); - MII.cch := Length( FCaption )*SizeOfKOLChar; + MII.dwTypeData := PKOLChar( FCaption ); + MII.cch := Length( FCaption )*SizeOfKOLChar; end else MII.fType := MII.fType or MFT_SEPARATOR; @@ -27603,13 +27510,13 @@ begin MII.fMask := MII.fMask or MIIM_SUBMENU; MII.hSubMenu := FHandle; end; - {$IFNDEF UNICODE_CTRLS} + {$IFNDEF UNICODE_CTRLS} InsertMenuItem( FParentMenu.FHandle, Before, ByPosition, Windows.PMenuitemInfo( @ MII )^ ); - {$ELSE} - InsertMenuItemW( FParentMenu.FHandle, Before, ByPosition, - Windows.PMenuitemInfoW( @ MII )^ ); - {$ENDIF} + {$ELSE} + InsertMenuItemW( FParentMenu.FHandle, Before, ByPosition, + Windows.PMenuitemInfoW( @ MII )^ ); + {$ENDIF} end else begin // hide menu item removing it @@ -28199,15 +28106,15 @@ begin MII.cbSize := MenuStructSize; MII.fMask := MIIM_ID; MII.wID := SubMenuToInsert.FId; - {$IFNDEF UNICODE_CTRLS} + {$IFNDEF UNICODE_CTRLS} SetMenuItemInfo( SubMenuToInsert.FParentMenu.FHandle, SubMenuToInsert.FParentMenu.FMenuItems.IndexOf( SubMenuToInsert ), TRUE, Windows.PMenuItemInfo( @ MII )^ ); - {$ELSE} + {$ELSE} SetMenuItemInfoW( SubMenuToInsert.FParentMenu.FHandle, SubMenuToInsert.FParentMenu.FMenuItems.IndexOf( SubMenuToInsert ), TRUE, Windows.PMenuItemInfoW( @ MII )^ ); - {$ENDIF} + {$ENDIF} end; RedrawFormMenuBar; end; @@ -28472,15 +28379,6 @@ end; //===================== Form ========================// -{$IFDEF USE_CONSTRUCTORS} -//[function NewForm] -function NewForm( AParent: PControl; const Caption: AnsiString ): PControl; -begin - new( Result, CreateForm( AParent, Caption ) ); -end; -//[END NewForm] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewForm] {$IFDEF GDI} {$IFDEF ASM_VERSION} @@ -28551,8 +28449,6 @@ end; {$ENDIF _X_} //[END NewForm] -{$ENDIF USE_CONSTRUCTORS} - {$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv //===================== Applet button ========================// @@ -28641,16 +28537,6 @@ begin end; //[END WndProcApp] -{$IFDEF USE_CONSTRUCTORS} -{$DEFINE CREATEAPPBUTTON_USED} -//[function NewApplet] -function NewApplet( const Caption: AnsiString ): PControl; -begin - new( Result, CreateApplet( Caption ) ); -end; -//[END NewApplet] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewApplet] {$IFDEF ASM_TLIST} {$ELSE ASM_VERSION} //Pascal @@ -28684,7 +28570,6 @@ begin end; {$ENDIF ASM_VERSION} //[END NewApplet] -{$ENDIF USE_CONSTRUCTORS} {$IFDEF CREATEAPPBUTTON_USED} procedure CreateAppButton( App: PControl ); @@ -28906,14 +28791,6 @@ begin Result := False; end; -{$IFDEF USE_CONSTRUCTORS} -//[function NewButton] -function NewButton( AParent: PControl; const Caption: KOLString ): PControl; -begin - new( Result, CreateButton( AParent, Caption ) ); -end; -{$ELSE USE_CONSTRUCTORS} - {$IFDEF ASM_VERSION} const ButtonClass: array[ 0..6 ] of KOLChar = ( 'B','U','T','T','O','N',#0 ); {$ENDIF ASM_VERSION} @@ -28953,7 +28830,6 @@ end; {$ENDIF ASM_VERSION} //[END NewButton] -{$ENDIF USE_CONSTRUCTORS} {$ENDIF WIN_GDI} {$IFDEF _X_} {$IFDEF GTK} @@ -29895,17 +29771,6 @@ end; {$ENDIF ASM_VERSION} //[END WndProcBitBtn] -{$IFDEF USE_CONSTRUCTORS} -//[function NewBitBtn] -function NewBitBtn( AParent: PControl; const Caption: AnsiString; - Options: TBitBtnOptions; Layout: TGlyphLayout; GlyphBitmap: HBitmap; - GlyphCount: Integer ): PControl; -begin - new( Result, CreateBitBtn( AParent, Caption, Options, Layout, GlyphBitmap, GlyphCount ) ); -end; -//[END NewBitBtn] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewBitBtn] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -30012,19 +29877,8 @@ end; {$ENDIF ASM_VERSION} //[END NewBitBtn] -{$ENDIF USE_CONSTRUCTORS} - //===================== Check box ========================// -{$IFDEF USE_CONSTRUCTORS} -//[function NewCheckbox] -function NewCheckbox( AParent: PControl; const Caption: AnsiString ): PControl; -begin - new( Result, CreateCheckbox( AParent, Caption ) ); -end; -//[END NewCheckbox] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewCheckbox] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -30048,8 +29902,6 @@ end; {$ENDIF ASM_VERSION} //[END NewCheckbox] -{$ENDIF USE_CONSTRUCTORS} - //[function NewCheckBox3State] function NewCheckBox3State( AParent: PControl; const Caption: KOLString ): PControl; begin @@ -30075,15 +29927,6 @@ end; {$ENDIF ASM_VERSION} //[END ClickRadio] -{$IFDEF USE_CONSTRUCTORS} -//[function NewRadiobox] -function NewRadiobox( AParent: PControl; const Caption: AnsiString ): PControl; -begin - new( Result, CreateRadiobox( AParent, Caption ) ); -end; -//[END NewRadiobox] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewRadiobox] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -30111,24 +29954,12 @@ end; {$ENDIF ASM_VERSION} //[END NewRadiobox] -{$ENDIF USE_CONSTRUCTORS} - //===================== Label ========================// {$ENDIF WIN_GDI} -{$IFNDEF USE_CONSTRUCTORS} {$IFDEF ASM_VERSION} const StaticClass: Array[0..6] of AnsiChar=('S','T','A','T','I','C',#0); {$ENDIF ASM_VERSION} -{$ENDIF not USE_CONSTRUCTORS} -{$IFDEF USE_CONSTRUCTORS} -//[function NewLabel] -function NewLabel( AParent: PControl; const Caption: AnsiString ): PControl; -begin - new( Result, CreateLabel( AParent, Caption ) ); -end; -//[END NewLabel] -{$ELSE not_USE_CONSTRUCTORS} //[FUNCTION NewLabel] {$IFDEF GDI} @@ -30176,21 +30007,11 @@ begin end; {$ENDIF GTK} {$ENDIF _X_} -{$ENDIF USE_CONSTRUCTORS} //[END NewLabel] {$IFDEF WIN_GDI} //===================== word wrap Label ========================// -{$IFDEF USE_CONSTRUCTORS} -//[function NewWordWrapLabel] -function NewWordWrapLabel( AParent: PControl; const Caption: AnsiString ): PControl; -begin - new( Result, CreateWordWrapLabel( AParent, Caption ) ); -end; -//[END NewWordWrapLabel] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewWordWrapLabel] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -30207,17 +30028,8 @@ end; {$ENDIF ASM_VERSION} //[END NewWordWrapLabel] -{$ENDIF USE_CONSTRUCTORS} - //===================== Label Effect ========================// -{$IFDEF USE_CONSTRUCTORS} -function NewLabelEffect( AParent: PControl; const Caption: AnsiString; ShadowDeep: Integer ): PControl; -begin - new( Result, CreateLabelEffect( AParent, Caption, ShadowDeep ) ); -end; -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewLabelEffect] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -30241,17 +30053,8 @@ end; {$ENDIF ASM_VERSION} //[END NewLabelEffect] -{$ENDIF USE_CONSTRUCTORS} - //===================== Paint box ========================// {$ENDIF WIN_GDI} -{$IFDEF USE_CONSTRUCTORS} -//[function NewPaintbox] -function NewPaintbox( AParent: PControl ): PControl; -begin - new( Result, CreatePaintBox( AParent ) ); -end; -{$ELSE not_USE_CONSTRUCTORS} //[FUNCTION NewPaintbox] {$IFDEF GDI} @@ -30304,7 +30107,6 @@ end; {$ENDIF _X_} //[END NewPaintbox] -{$ENDIF USE_CONSTRUCTORS} {$IFDEF WIN_GDI} {$IFDEF _D2} @@ -30838,15 +30640,6 @@ end; //===================== Groupbox ========================// -{$IFDEF USE_CONSTRUCTORS} -//[function NewGroupbox] -function NewGroupbox( AParent: PControl; const Caption: AnsiString ): PControl; -begin - new( Result, CreateGroupbox( AParent, Caption ) ); -end; -//[END NewGroupbox] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewGroupbox] {$IFDEF ASM_UNICODE} {$ELSE ASM_VERSION} //Pascal @@ -30884,19 +30677,8 @@ end; {$ENDIF ASM_VERSION} //[END NewGroupbox] -{$ENDIF USE_CONSTRUCTORS} - //===================== Panel ========================// -{$IFDEF USE_CONSTRUCTORS} -//[function NewPanel] -function NewPanel( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl; -begin - new( Result, CreatePanel( AParent, EdgeStyle ) ); -end; -//[END NewPanel] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewPanel] {$IFDEF ASM_UNICODE} {$ELSE ASM_VERSION} //Pascal @@ -30925,8 +30707,6 @@ end; {$ENDIF ASM_VERSION} //[END NewPanel] -{$ENDIF USE_CONSTRUCTORS} - //===================== Splitter ==============================// //{$DEFINE USE_ASM_DODRAG} @@ -31104,16 +30884,6 @@ begin end; //[END NewSplitter] -{$IFDEF USE_CONSTRUCTORS} -//[function NewSplitterEx] -function NewSplitterEx( AParent: PControl; MinSizePrev, MinSizeNext: Integer; - EdgeStyle: TEdgeStyle ): PControl; -begin - new( Result, CreateSplitter( AParent, MinSizePrev, MinSizeNext, EdgeStyle ) ); -end; -//[END NewSplitterEx] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewSplitterEx] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -31160,8 +30930,6 @@ end; {$ENDIF ASM_VERSION} //[END NewSplitterEx] -{$ENDIF USE_CONSTRUCTORS} - //===================== MDI client window control =============// //[procedure DestroyMDIChildren] @@ -31493,15 +31261,6 @@ end; //===================== Gradient panel ========================// -{$IFDEF USE_CONSTRUCTORS} -//[function NewGradientPanel] -function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl; -begin - new( Result, CreateGradientPanel( AParent, Color1, Color2 ) ); -end; -//[END NewGradientPanel] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewGradientPanel] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -31520,19 +31279,6 @@ end; {$ENDIF ASM_VERSION} //[END NewGradientPanel] -{$ENDIF USE_CONSTRUCTORS} - -{$IFDEF USE_CONSTRUCTORS} -//[function NewGradientPanelEx] -function NewGradientPanelEx( AParent: PControl; Color1, Color2: TColor; - Style: TGradientStyle; Layout: TGradientLayout ): PControl; -begin - new( Result, CreateGradientPanelEx( AParent, Color1, Color2, - Style, Layout ) ); -end; -//[END NewGradientPanelEx] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewGradientPanelEx] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -31554,8 +31300,6 @@ end; {$ENDIF ASM_VERSION} //[END NewGradientPanelEx] -{$ENDIF USE_CONSTRUCTORS} - //===================== Edit box ========================// const Editflags: array [ TEditOption ] of Integer = ( @@ -31565,15 +31309,6 @@ const Editflags: array [ TEditOption ] of Integer = ( es_NoHideSel, es_OemConvert, es_Password, es_Readonly, es_UpperCase, es_WantReturn, 0, es_Number ); -{$IFDEF USE_CONSTRUCTORS} -//[function NewEditbox] -function NewEditbox( AParent: PControl; Options: TEditOptions ) : PControl; -begin - new( Result, CreateEditbox( AParent, Options ) ); -end; -//[END NewEditbox] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewEditBox] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -31605,8 +31340,6 @@ end; {$ENDIF ASM_VERSION} //[END NewEditBox] -{$ENDIF USE_CONSTRUCTORS} - //===================== List box ========================// const ListFlags: array[TListOption] of Integer = ( @@ -31617,15 +31350,6 @@ const ListFlags: array[TListOption] of Integer = ( not LBS_HASSTRINGS, LBS_NODATA, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE, WS_HSCROLL ); -{$IFDEF USE_CONSTRUCTORS} -//[function NewListbox] -function NewListbox( AParent: PControl; Options: TListOptions ): PControl; -begin - new( Result, CreateListbox( AParent, Options ) ); -end; -//[END NewListbox] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewListbox] {$IFDEF ASM_UNICODE} {$ELSE ASM_VERSION} //Pascal @@ -31647,8 +31371,6 @@ end; {$ENDIF ASM_VERSION} //[END NewListbox] -{$ENDIF USE_CONSTRUCTORS} - //===================== Combo box ========================// //[FUNCTION ComboboxDropDown] @@ -31887,14 +31609,6 @@ const ComboFlags: array[ TComboOption ] of Integer = ( CBS_OemConvert, CBS_Sort, CBS_UpperCase, CBS_OWNERDRAWFIXED, CBS_OWNERDRAWVARIABLE, CBS_SIMPLE ); -{$IFDEF USE_CONSTRUCTORS} -//[function NewCombobox] -function NewCombobox( AParent: PControl; Options: TComboOptions ): PControl; -begin - new( Result, CreateCombobox( AParent, Options ) ); -end; -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewCombobox] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -31931,8 +31645,6 @@ end; {$ENDIF ASM_VERSION} //[END NewCombobox] -{$ENDIF USE_CONSTRUCTORS} - //[FUNCTION WndProcResiz] {$IFDEF ASM_TLIST} {$ELSE ASM_VERSION} //Pascal @@ -32005,15 +31717,6 @@ end; //==================== Progress bar ======================// -{$IFDEF USE_CONSTRUCTORS} -//[function NewProgressbar] -function NewProgressbar( AParent: PControl ): PControl; -begin - new( Result, CreateProgressbar( AParent ) ); -end; -//[END NewProgressbar] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewProgressbar] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -32034,17 +31737,6 @@ end; {$ENDIF ASM_VERSION} //[END NewProgressbar] -{$ENDIF USE_CONSTRUCTORS} - -{$IFDEF USE_CONSTRUCTORS} -//[function NewProgressbarEx] -function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PControl; -begin - new( Result, CreateProgressbarEx( AParent, Options ) ); -end; -//[END NewProgressbarEx] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewProgressbarEx] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -32058,8 +31750,6 @@ end; {$ENDIF ASM_VERSION} //[END NewProgressbarEx] -{$ENDIF USE_CONSTRUCTORS} - //===================== List view ========================// //[FUNCTION WndProcNotify] @@ -32169,17 +31859,6 @@ end; {$ENDIF ASM_VERSION} //[END ApplyImageLists2ListView] -{$IFDEF USE_CONSTRUCTORS} -//[function NewListView] -function NewListView( AParent: PControl; Style: TListViewStyle; Options: TListViewOptions; - ImageListSmall, ImageListNormal, ImageListState: PImageList ): PControl; -begin - new( Result, CreateListView( AParent, Style, Options, ImageListSmall, - ImageListNormal, ImageListState ) ); -end; -//[END NewListView] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewListView] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -32210,8 +31889,6 @@ end; {$ENDIF ASM_VERSION} //[END NewListView] -{$ENDIF USE_CONSTRUCTORS} - //===================== Tree view ========================// //[FUNCTION WndProcTreeView] @@ -32345,15 +32022,6 @@ const TVS_TRACKSELECT, TVS_SINGLEEXPAND, TVS_INFOTIP, TVS_FULLROWSELECT, TVS_NOSCROLL, TVS_NONEVENHEIGHT ); -{$IFDEF USE_CONSTRUCTORS} -//[function NewTreeView] -function NewTreeView( AParent: PControl; Options: TTreeViewOptions; - ImgListNormal, ImgListState: PImageList ): PControl; -begin - new( Result, CreateTreeView( AParent, Options, ImgListNormal, ImgListState ) ); -end; -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewTreeView] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -32379,8 +32047,6 @@ end; {$ENDIF ASM_VERSION} //[END NewTreeView] -{$ENDIF USE_CONSTRUCTORS} - //===================== Tab Control ========================// //[FUNCTION WndProcTabControl] @@ -32528,16 +32194,6 @@ const TabControlFlags: array[ TTabControlOption ] of Integer = ( TCS_BUTTONS, TCS_MULTILINE, TCS_MULTISELECT, TCS_RIGHTJUSTIFY, TCS_SCROLLOPPOSITE, TCS_BOTTOM, TCS_VERTICAL, TCS_FLATBUTTONS, TCS_HOTTRACK, 0, TCS_OWNERDRAWFIXED ); -{$IFDEF USE_CONSTRUCTORS} -//[function NewTabControl] -function NewTabControl( AParent: PControl; Tabs: array of String; Options: TTabControlOptions; - ImgList: PImageList; ImgList1stIdx: Integer ): PControl; -begin - new( Result, CreateTabControl( AParent, Tabs, Options, ImgList, ImgList1stIdx ) ); -end; -//[END NewTabControl] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewTabControl] {$IFDEF ASM_UNICODE} {$ELSE ASM_VERSION} //Pascal @@ -32604,8 +32260,6 @@ end; //[END NewTabEmpty] {$ENDIF} -{$ENDIF USE_CONSTRUCTORS} - //===================== Tool bar ========================// //[FUNCTION WndProcToolbarCtr] @@ -32824,17 +32478,6 @@ const ToolbarAligns: array[ TControlAlign ] of DWORD = TBSTYLE_FLAT, TBSTYLE_TRANSPARENT, TBSTYLE_WRAPABLE, CCS_NODIVIDER, 0, TBSTYLE_CUSTOMERASE ); -{$IFDEF USE_CONSTRUCTORS} -//[function NewToolbar] -function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions; - Bitmap: HBitmap; Buttons: array of PAnsiChar; - BtnImgIdxArray: array of Integer ) : PControl; -begin - new( Result, CreateToolbar( AParent, Align, Options, Bitmap, Buttons, BtnImgIdxArray ) ); -end; -//[END NewToolbar] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewToolbar] {$IFDEF ASM_UNICODE} {$ELSE ASM_VERSION} //Pascal @@ -32892,8 +32535,6 @@ end; {$ENDIF ASM_VERSION} //[END NewToolbar] -{$ENDIF USE_CONSTRUCTORS} - //================== DateTimePicker =====================// function WndProcDateTimePickerNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; @@ -33156,15 +32797,6 @@ const RichEditflags: array [ TEditOption ] of Integer = ( 0 {es_UpperCase - not supported}, es_WantReturn, 0, es_Number ); -{$IFDEF USE_CONSTRUCTORS} -//[function NewRichEdit1] -function NewRichEdit1( AParent: PControl; Options: TEditOptions ): PControl; -begin - new( Result, CreateRichEdit1( AParent, Options ) ); -end; -//[END NewRichEdit1] -{$ELSE not_USE_CONSTRUCTORS} - //[FUNCTION NewRichEdit1] {$IFDEF ASM_UNICODE} {$ELSE ASM_VERSION} //Pascal @@ -33248,8 +32880,6 @@ end; //[END NewRichEdit1] {$ENDIF NOT_USE_RICHEDIT} -{$ENDIF USE_CONSTRUCTORS} - //[API OleInitialize] function OleInitialize(pwReserved: Pointer): HResult; stdcall; external 'ole32.dll' name 'OleInitialize'; @@ -33316,14 +32946,6 @@ end; {+} {$IFNDEF NOT_USE_RICHEDIT} -{$IFDEF USE_CONSTRUCTORS} -//[function NewRichEdit] -function NewRichEdit( AParent: PControl; Options: TEditOptions ): PControl; -begin - new( Result, CreateRichEdit( AParent, Options ) ); -end; -//[END NewRichEdit] -{$ELSE not_USE_CONSTRUCTORS} //[FUNCTION NewRichEdit] {$IFDEF ASM_VERSION} @@ -33383,7 +33005,6 @@ end; {$ENDIF ASM_VERSION} //[END NewRichEdit] -{$ENDIF USE_CONSTRUCTORS} {$ENDIF NOT_USE_RICHEDIT} //=====================================================================// @@ -33846,21 +33467,21 @@ begin {$ENDIF INPACKAGE} if fControlClassName <> nil then begin - GetClassInfo( hInstance,fControlClassName,Params.WindowClass ); + GetClassInfo( hInstance,fControlClassName,Params.WindowClass ); Params.WindowClass.hInstance := Params.Inst; - Params.WindowClass.style := Params.WindowClass.style and - not CS_OFF or CS_ON; + Params.WindowClass.style := Params.WindowClass.style and + not CS_OFF or CS_ON; end; if fDefWndProc = nil then fDefWndProc := {$ifdef FPC21}@{$endif}Params.WindowClass.lpfnWndProc; if Params.WndParent = 0 then - if Params.Style and WS_CHILD <> 0 then Exit; + if Params.Style and WS_CHILD <> 0 then Exit; - {$IFNDEF UNICODE_CTRLS} - ClassRegistered := GetClassInfo( Params.WindowClass.hInstance,Params.WinClassName, TempClass ); - {$ELSE} - ClassRegistered := GetClassInfoW( Params.WindowClass.hInstance,Params.WinClassName, TempClass ); - {$ENDIF} + {$IFNDEF UNICODE_CTRLS} + ClassRegistered := GetClassInfo( Params.WindowClass.hInstance,Params.WinClassName, TempClass ); + {$ELSE} + ClassRegistered := GetClassInfoW( Params.WindowClass.hInstance,Params.WinClassName, TempClass ); + {$ENDIF} {$IFDEF INPACKAGE} Log( '/// Registering window class' ); @@ -33869,11 +33490,11 @@ begin begin Params.WindowClass.lpszClassName := Params.WinClassName; Params.WindowClass.lpfnWndProc := @ WndFunc; - {$IFNDEF UNICODE_CTRLS} + {$IFNDEF UNICODE_CTRLS} if RegisterClass( Params.WindowClass ) = 0 then Exit; - {$ELSE} - if RegisterClassW(Params.WindowClass ) = 0 then Exit; - {$ENDIF} + {$ELSE} + if RegisterClassW(Params.WindowClass ) = 0 then Exit; + {$ENDIF} end; {$IFDEF DEBUG_CREATEWINDOW} @@ -33891,10 +33512,10 @@ begin Params.Param ); {$ELSE} fHandle := CreateWindowExW( Params.ExStyle{ or WS_EX_RTLREADING}, Params.WinClassName, - Params.Caption, Params.Style, Params.X, Params.Y, - Params.Width, Params.Height, Params.WndParent, - Params.Menu, Params.WindowClass.hInstance, - Params.Param ); + Params.Caption, Params.Style, Params.X, Params.Y, + Params.Width, Params.Height, Params.WndParent, + Params.Menu, Params.WindowClass.hInstance, + Params.Param ); {$ENDIF} {$IFDEF INPACKAGE} @@ -33903,13 +33524,13 @@ begin {$IFDEF DEBUG_CREATEWINDOW} - if fHandle = 0 then + if fHandle = 0 then begin - MessageBox(0, + MessageBox(0, PKOLChar(SysErrorMessage(GetLastError)), 'Error creating window',mb_iconhand); - Exit; - end; + Exit; + end; {$ENDIF} {$IFDEF INPACKAGE} Log( '/// SendMessage WM_UPDATEUISTATE' ); @@ -34000,17 +33621,17 @@ begin with Params do begin SaveInstance := WindowClass.hInstance; - {$IFNDEF UNICODE_CTRLS} + {$IFNDEF UNICODE_CTRLS} if not GetClassInfo(HInstance, fControlClassName, WindowClass) and not GetClassInfo(0, fControlClassName, WindowClass) then GetClassInfo(WindowClass.hInstance, fControlClassName, WindowClass); - {$ELSE} - if not GetClassInfoW(HInstance, pWideChar(fControlClassName), WindowClass) and - not GetClassInfoW(0, pWidechar(fControlClassName), WindowClass) - then - GetClassInfoW(WindowClass.hInstance, pWideChar(fControlClassName), WindowClass); - {$ENDIF} + {$ELSE} + if not GetClassInfoW(HInstance, pWideChar(fControlClassName), WindowClass) and + not GetClassInfoW(0, pWidechar(fControlClassName), WindowClass) + then + GetClassInfoW(WindowClass.hInstance, pWideChar(fControlClassName), WindowClass); + {$ENDIF} WindowClass.hInstance := SaveInstance; WindowClass.style := WindowClass.style and not CS_OFF or CS_ON; end; @@ -34432,7 +34053,7 @@ begin and not (fKeyPreviewing {and ((Msg.Message=WM_KEYDOWN) {or (Msg.message = WM_CHAR) )}) {$ENDIF} - then + then begin Result := 0; // Jump to PassFun here. Prevents beep in case when WM_KEYDOWN @@ -38008,7 +37629,7 @@ var CShadow: TColor; Target: PCanvas; Txt: KOLString; - //LCaption: PKOLChar; + //LCaption: PKOLChar; OldPaintDC: HDC; procedure doTextOut( shfx, shfy: Integer; col: TColor ); @@ -42411,14 +42032,6 @@ end; { -- Image List -- } //* -{$IFDEF USE_CONSTRUCTORS} -//[function NewImageList] -function NewImageList( AOwner: PControl ): PImageList; -begin - new( Result, CreateImageList( AOwner ) ); -end; -//[END NewImageList] -{$ELSE not_USE_CONSTRUCTORS} //[function NewImageList] function NewImageList( AOwner: PControl ): PImageList; begin @@ -42445,7 +42058,6 @@ begin {$ENDIF} AOwner.fImageList := Result; end; -{$ENDIF} //[API ImageList_XXX] function ImageList_Create; stdcall; external cctrl name 'ImageList_Create'; @@ -48534,6 +48146,20 @@ end; {$ENDIF ASM_VERSION} //[END _GetDIBPixelsTrueColor] +//[FUNCTION _GetDIBPixelsTrueColorWithAlpha] +function _GetDIBPixelsTrueColorWithAlpha( Bmp: PBitmap; X, Y: Integer ): TColor; +var + Pixel: DWORD; + RGB: TRGBQuad; +begin + Pixel := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta + + X * Bmp.fBytesPerPixel )^ and $FFFFFFFF; + RGB := TRGBQuad(Pixel); + Swap(RGB.rgbBlue, RGB.rgbRed); + Result := TColor( RGB ); +end; +//[END _GetDIBPixelsTrueColorWithAlpha] + //[function TBitmap.GetDIBPixels] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -48584,7 +48210,7 @@ begin begin fPixelsPerByteMask := 1; fBytesPerPixel := 4; - fGetDIBPixels := _GetDIBPixelsTrueColor; + fGetDIBPixels := {$IFDEF FIXDIB32}_GetDIBPixelsTrueColorWithAlpha{$ELSE}_GetDIBPixelsTrueColor{$ENDIF}; end; else; end; @@ -48670,6 +48296,20 @@ end; {$ENDIF ASM_VERSION} //[END _SetDIBPixelsTrueColor] +//[PROCEDURE _SetDIBPixelsTrueColorWithAlpha] +procedure _SetDIBPixelsTrueColorWithAlpha(Bmp: PBitmap; X, Y: Integer; Value: TColor); +var RGB: TRGBQuad; + Pos: PDWord; +begin + RGB := TRGBQuad({Color2RGB}(Value)); + Swap(RGB.rgbBlue, RGB.rgbRed); + + Pos := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta + + X * Bmp.fBytesPerPixel ); + Pos^ := Pos^ {and $FF000000} or DWORD(RGB); +end; +//[END _SetDIBPixelsTrueColorWithAlpha] + //[procedure TBitmap.SetDIBPixels] {$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal @@ -48720,7 +48360,7 @@ begin begin fPixelsPerByteMask := 1; fBytesPerPixel := 4; - fSetDIBPixels := _SetDIBPixelsTrueColor; + fSetDIBPixels := {$IFDEF FIXDIB32}_SetDIBPixelsTrueColorWithAlpha{$ELSE}_SetDIBPixelsTrueColor{$ENDIF}; end; else; end; @@ -49225,6 +48865,9 @@ var DesiredSize : Integer; else if BIH.biBitCount = 16 then begin + if (BIH.biCompression = BI_BITFIELDS) then // mdw + Stream2Stream(Mem, Strm, 12) + else for I := 0 to 2 do begin J := InitColors[ I ]; @@ -55268,747 +54911,6 @@ begin AttachProc( WndProcDrag ); end; -{-} -{$IFDEF USE_CONSTRUCTORS} //****************************************************// - // -//[constructor TControl.CreateWindowed] -constructor TControl.CreateWindowed(AParent: PControl; AClassName: PKOLChar; // - ACtl3D: Boolean); // -begin // - CreateParented( AParent ); // - fOnDynHandlers := WndProcDummy; // - fWndProcKeybd := WndProcDummy; // - fWndProcResizeFlicks := WndProcDummy; // - fCommandActions.aClear := ClearText; // - //fWindowed := True; // is set in TControl.Init - fControlClassName := AClassName; // - // - fControlClick := DummyObjProc; // - // - fColor := clBtnFace; // - fTextColor := clWindowText; // - fMargin := 2; // - fCtl3D := True; // - fCtl3Dchild := True; // - if AParent <> nil then // - begin // - fWndProcResizeFlicks := AParent.fWndProcResizeFlicks; // - fGotoControl := AParent.fGotoControl; // - fDoubleBuffered := AParent.fDoubleBuffered; // - fTransparent := AParent.fTransparent; // - fCtl3Dchild := AParent.fCtl3Dchild; // - if AParent.fCtl3Dchild then // - fCtl3D := ACtl3D // - else // - fCtl3D := False; // - fMargin := AParent.fMargin; // - with fBoundsRect do // - begin // - Left := AParent.fMargin + AParent.fClientLeft; // - Top := AParent.fMargin + AParent.fClientTop; // - Right := Left + 64; // - Bottom := Top + 64; // - end; // - fTextColor := AParent.fTextColor; // - fFont := fFont.Assign( AParent.fFont ); // - if fFont <> nil then // - begin // - fFont.fOnChange := FontChanged; // - FontChanged( fFont ); // - end; // - fColor := AParent.fColor; // - fBrush := fBrush.Assign( AParent.fBrush ); // - if fBrush <> nil then // - begin // - fBrush.fOnChange := BrushChanged; // - BrushChanged( fBrush ); // - end; // - end; // -end; // - // -//[constructor TControl.CreateApplet] -constructor TControl.CreateApplet(const ACaption: AnsiString); // -begin // - AppButtonUsed := True; // - CreateWindowed( nil, 'App', TRUE ); // - FIsApplet := TRUE; // - fStyle := WS_VISIBLE or WS_SYSMENU or WS_POPUP or WS_MINIMIZEBOX // - or WS_CAPTION; // - fExStyle := WS_EX_APPWINDOW; // - FCreateWndExt := CreateAppButton; // - AttachProc( WndProcApp ); // - Caption := ACaption; // -end; // - // -//[constructor TControl.CreateForm] -constructor TControl.CreateForm(AParent: PControl; const ACaption: AnsiString); // -begin // - CreateWindowed( AParent, 'Form', TRUE ); // - AttachProc( WndProcForm ); // - AttachProc( WndProcDoEraseBkgnd ); // - Caption := ACaption; // -end; // - // -//[constructor TControl.CreateControl] -constructor TControl.CreateControl(AParent: PControl; AClassName: PAnsiChar; // - AStyle: DWORD; ACtl3D: Boolean; Actions: PCommandActions); // -var Form: PControl; // -begin // - CreateWindowed( AParent, AClassName, ACtl3D ); // - if Actions <> nil then // - fCommandActions := Actions^; // - fIsControl := True; // - fStyle := AStyle or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; // - fVisible := (Style and WS_VISIBLE) <> 0; // - fTabstop := (Style and WS_TABSTOP) <> 0; // - if (AParent <> nil) then // - begin // - Inc( AParent.ParentForm.fTabOrder ); // - fTabOrder := AParent.ParentForm.fTabOrder; // - end; // - fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ]; // - if fCtl3D then // - begin // - fStyle := fStyle and not WS_BORDER; // - fExStyle := fExStyle or WS_EX_CLIENTEDGE; // - end; // - if (Style and WS_TABSTOP) <> 0 then // - begin // - Form := ParentForm; // - if Form <> nil then // - if Form.FCurrentControl = nil then // - Form.FCurrentControl := @Self; // - end; // - //fCreateParamsExt := CreateParams2; // - fMenu := CtlIdCount; // - Inc( CtlIdCount ); // - AttachProc( WndProcCtrl ); // -end; // - // -//[constructor TControl.CreateButton] -constructor TControl.CreateButton(AParent: PControl; // - const ACaption: AnsiString); // -begin // - CreateControl( AParent, 'BUTTON', // - WS_VISIBLE or WS_CHILD or // - BS_PUSHLIKE or WS_TABSTOP, False, @ButtonActions ); // - with fBoundsRect do // - Bottom := Top + 22; // - fTextAlign := taCenter; // - Caption := ACaption; // -end; // - // -//[constructor TControl.CreateBitBtn] -constructor TControl.CreateBitBtn(AParent: PControl; // - const ACaption: AnsiString; AOptions: TBitBtnOptions; ALayout: TGlyphLayout; // - AGlyphBitmap: HBitmap; AGlyphCount: Integer); // -var // - B: TBitmapInfo; // - W, H: Integer; // -begin // - CreateControl( AParent, 'BUTTON', WS_VISIBLE or WS_CHILD or // - WS_TABSTOP or BS_OWNERDRAW, False, @ButtonActions ); // - fBitBtnOptions := AOptions; // - fGlyphLayout := ALayout; // - fGlyphBitmap := AGlyphBitmap; // - with fBoundsRect do // - begin // - Bottom := Top + 22; // - W := 0; H := 0; // - if AGlyphBitmap <> 0 then // - begin // - if bboImageList in AOptions then // - ImageList_GetIconSize( AGlyphBitmap, W, H ) // - else // - begin // - if GetObject( AGlyphBitmap, Sizeof(B), @B ) > 0 then // - begin // - W := B.bmiHeader.biWidth; // - H := B.bmiHeader.biHeight; // - if AGlyphCount = 0 then // - AGlyphCount := W div H; // - if AGlyphCount > 1 then // - W := W div AGlyphCount; // - end; // - end; // - if W > 0 then // - if ACaption = '' then // - Right := Left + W // - else // - Right := Right + W; // - if H > 0 then // - Bottom := Top + H; // - if not ( bboNoBorder in AOptions ) then // - begin // - if W > 0 then // - Inc( Right, 2 ); // - if H > 0 then // - Inc( Bottom, 2 ); // - end; // - end; // - fGlyphWidth := W; // - fGlyphHeight := H; // - end; // - fGlyphCount := AGlyphCount; // - if AParent <> nil then // - AParent.AttachProc( WndProc_DrawItem ); // - AttachProc( WndProcBitBtn ); // - fTextAlign := taCenter; // - Caption := ACaption; // -end; // - // -//[constructor TControl.CreateLabel] -constructor TControl.CreateLabel(AParent: PControl; // - const ACaption: AnsiString); // -begin // - CreateControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or // - SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY, // - False, @LabelActions ); // - fIsStaticControl := 1; // - fSizeRedraw := True; // - fBoundsRect.Bottom := fBoundsRect.Top + 22; // - Caption := ACaption; // -end; // - // -//[constructor TControl.CreateWordWrapLabel] -constructor TControl.CreateWordWrapLabel(AParent: PControl; // - const ACaption: AnsiString); // -begin // - CreateLabel( AParent, ACaption ); // - fBoundsRect.Bottom := fBoundsRect.Top + 44; // - fStyle := fStyle and not SS_LEFTNOWORDWRAP; // -end; // - // -//[constructor TControl.CreateLabelEffect] -constructor TControl.CreateLabelEffect(AParent: PControl; ACaption: AnsiString; // - AShadowDeep: Integer); // -begin // - CreateLabel( AParent, ACaption ); // - fIsStaticControl := 0; // - AttachProc( WndProcLabelEffect ); // - fTextAlign := taCenter; // - fTextColor := clBtnShadow; // - fShadowDeep := AShadowDeep; // - fIgnoreWndCaption := True; // - with fBoundsRect do // - begin // - Bottom := Top + 40; // - end; // -end; // - // -//[constructor TControl.CreatePaintBox] -constructor TControl.CreatePaintBox(AParent: PControl); // -begin // - CreateLabel( AParent, '' ); // - with fBoundsRect do // - begin // - Right := Left + 40; // - Bottom := Top + 40; // - end; // -end; // - // -{$IFDEF ASM_VERSION} // -//[constructor TControl.CreateGradientPanel] -constructor TControl.CreateGradientPanel(AParent: PControl; AColor1, // - AColor2: TColor); // -asm //cmd //opd // - XOR EDX, EDX // - PUSH EDX // - CALL CreateLabel // - MOV ECX, AColor1 // - MOV [EAX].fColor1, ECX // - MOV ECX, AColor2 // - MOV [EAX].fColor2, ECX // - MOV EDX, [EAX].fBoundsRect.Left // - ADD EDX, 40 // - MOV [EAX].fBoundsRect.Right, EDX // - MOV EDX, [EAX].fBoundsRect.Top // - ADD EDX, 40 // - MOV [EAX].fBoundsRect.Bottom, EDX // - PUSH EAX // - MOV EDX, offset[ WndProcGradient ] // - CALL AttachProc // - POP EAX // -end; // -{$ELSE ASM_VERSION} //Pascal // -constructor TControl.CreateGradientPanel(AParent: PControl; AColor1, // - AColor2: TColor); // -begin // - CreateLabel( AParent, '' ); // - AttachProc( WndProcGradient ); // - fColor2 := AColor2; // - fColor1 := AColor1; // - with fBoundsRect do // - begin // - Right := Left + 40; // - Bottom := Top + 40; // - end; // -end; // -{$ENDIF ASM_VERSION} // - // -//[constructor TControl.CreateGradientPanelEx] -constructor TControl.CreateGradientPanelEx(AParent: PControl; AColor1, // - AColor2: TColor; AStyle: TGradientStyle; ALayout: TGradientLayout); // -begin // - CreateLabel( AParent, '' ); // - AttachProc( WndProcGradientEx ); // - fColor2 := AColor2; // - fColor1 := AColor1; // - fGradientStyle := AStyle; // - fGradientLayout := ALayout; // - with fBoundsRect do // - begin // - Right := Left + 40; // - Bottom := Top + 40; // - end; // -end; // - // -//[constructor TControl.CreateGroupbox] -constructor TControl.CreateGroupbox(AParent: PControl; // - const ACaption: AnsiString); // -begin // - CreateButton( AParent, ACaption ); // - with fBoundsRect do // - begin // - Right := Left + 100; // - Bottom := Top + 100; // - end; // - fStyle := WS_VISIBLE or WS_CHILD or BS_GROUPBOX or WS_TABSTOP; // - fClientTop := 22; // - fClientLeft := 2; // - fClientBottom := 2; // - fClientRight := 2; // - fTabstop := False; // -end; // - // -//[constructor TControl.CreateCheckbox] -constructor TControl.CreateCheckbox(AParent: PControl; // - const ACaption: AnsiString); // -begin // - CreateButton( AParent, ACaption ); // - with fBoundsRect do // - begin // - Right := Left + 72; // - end; // - fStyle := WS_VISIBLE or WS_CHILD or // - BS_AUTOCHECKBOX or WS_TABSTOP; // -end; // - // -//[constructor TControl.CreateRadiobox] -constructor TControl.CreateRadiobox(AParent: PControl; // - const ACaption: AnsiString); // -begin // - CreateCheckbox( AParent, ACaption ); // - fStyle := WS_VISIBLE or WS_CHILD or // - BS_RADIOBUTTON or WS_TABSTOP or WS_GROUP; // - fControlClick := ClickRadio; // - if AParent <> nil then // - begin // - AParent.fRadioLast := fMenu; // - if AParent.fRadio1st = 0 then // - begin // - AParent.fRadio1st := fMenu; // - SetRadioChecked; // - end; // - end; // -end; // - // -//[constructor TControl.CreateEditbox] -constructor TControl.CreateEditbox(AParent: PControl; // - AOptions: TEditOptions); // -var Flags: Integer; // -begin // - Flags := MakeFlags( @AOptions, EditFlags ); // - if not(eoMultiline in AOptions) then // - Flags := Flags and not(WS_HSCROLL or WS_VSCROLL); // - CreateControl( AParent, 'EDIT', WS_VISIBLE or WS_CHILD or WS_TABSTOP // - or WS_BORDER or Flags, True, @EditActions ); // -//YS fCursor := LoadCursor( 0, IDC_IBEAM ); // //YS - with fBoundsRect do // - begin // - Right := Left + 100; // - Bottom := Top + 22; // - if eoMultiline in AOptions then // - begin // - Right := Right + 100; // - Bottom := Top + 200; // - end; // - end; // - fColor := clWindow; // - fLookTabKeys := [ tkTab, tkUpDown, tkPageUpPageDn ]; // - if eoMultiline in AOptions then // - fLookTabKeys := [ tkTab ]; // - if eoWantTab in AOptions then // - fLookTabKeys := fLookTabKeys - [ tkTab ]; // -end; // - // -//[constructor TControl.CreatePanel] -constructor TControl.CreatePanel(AParent: PControl; AStyle: TEdgeStyle); // -const Edgestyles: array[ TEdgeStyle ] of DWORD = ( WS_DLGFRAME, SS_SUNKEN, 0 ); // -begin // - CreateControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or // - SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY, False, // - @LabelActions ); // - with fBoundsRect do // - begin // - Right := Left + 100; // - Bottom := Top + 100; // - end; // - Style := Style or Edgestyles[ AStyle ]; // - ExStyle := ExStyle or WS_EX_CONTROLPARENT; // -end; // - // -//[constructor TControl.CreateSplitter] -constructor TControl.CreateSplitter(AParent: PControl; AMinSizePrev, // - AMinSizeNext: Integer; EdgeStyle: TEdgeStyle); // -var PrevCtrl: PControl; // - Sz0: Integer; // -begin // - CreatePanel( AParent, EdgeStyle ); // - fSplitMinSize1 := AMinSizePrev; // - fSplitMinSize2 := AMinSizeNext; // - Sz0 := 4; // - with fBoundsRect do // - begin // - Right := Left + Sz0; // - Bottom := Top + Sz0; // - end; // - if AParent <> nil then // - begin // - if AParent.fChildren.fCount > 1 then // - begin // - PrevCtrl := AParent.fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ AParent.fChildren.fCount - 2 ]; // - case PrevCtrl.FAlign of // - caLeft, caRight: // - begin // - fCursor := LoadCursor( 0, IDC_SIZEWE ); // - end; // - caTop, caBottom: // - begin // - fCursor := LoadCursor( 0, IDC_SIZENS ); // - end; // - end; // - Align := PrevCtrl.FAlign; // - end; // - end; // - AttachProc( WndProcSplitter ); // -end; // - // -//[constructor TControl.CreateListbox] -constructor TControl.CreateListbox(AParent: PControl; // - AOptions: TListOptions); // -var Flags: Integer; // -begin // - Flags := MakeFlags( @AOptions, ListFlags ); // - CreateControl( AParent, 'LISTBOX', WS_VISIBLE or WS_CHILD or WS_TABSTOP // - or WS_BORDER or WS_VSCROLL // - or LBS_NOTIFY or Flags, True, @ListActions ); // - with fBoundsRect do // - begin // - Right := Right + 100; // - Bottom := Top + 200; // - end; // - fColor := clWindow; // - fLookTabKeys := [ tkTab, tkLeftRight ]; // -end; // - // -//[constructor TControl.CreateCombobox] -constructor TControl.CreateCombobox(AParent: PControl; // - AOptions: TComboOptions); // -var Flags: Integer; // -begin // - Flags := MakeFlags( @AOptions, ComboFlags ); // - CreateControl( AParent, 'COMBOBOX', // - WS_VISIBLE or WS_CHILD or WS_VSCROLL or // - CBS_DROPDOWN or CBS_HASSTRINGS or WS_TABSTOP or Flags, // - True, @ComboActions ); // - fCreateWndExt := CreateComboboxWnd; // - fDropDownProc := ComboboxDropDown; // - fClsStyle := fClsStyle or CS_DBLCLKS; // - with fBoundsRect do // - begin // - Right := Left + 100; // - Bottom := Top + 22; // - end; // - fColor := clWindow; // - fLookTabKeys := [ tkTab ]; // - if coReadOnly in AOptions then // - fLookTabKeys := [ tkTab, tkLeftRight ]; // -end; // - // -//[constructor TControl.CreateCommonControl] -constructor TControl.CreateCommonControl(AParent: PControl; // - AClassName: PAnsiChar; AStyle: DWORD; ACtl3D: Boolean; // - Actions: PCommandActions); // -begin // - {*************} DoInitCommonControls( ICC_WIN95_CLASSES ); // - CreateControl( AParent, AClassName, AStyle, ACtl3D, Actions ); // - fIsCommonControl := True; // - if AParent <> nil then // - begin // - AttachProc( WndProcParentResize ); // - AParent.AttachProc( WndProcResize ); // - AttachProc( WndProcCommonNotify ); // - AParent.AttachProc( WndProcNotify ); // - end; // -end; // - // -//[constructor TControl.CreateRichEdit1] -constructor TControl.CreateRichEdit1(AParent: PControl; // - AOptions: TEditOptions); // -var Flags, I: Integer; // -begin // - if FRichEditModule = 0 then // - begin // - for I := 0 to High( RichEditLibnames ) do // - begin // - FRichEditModule := LoadLibrary( RichEditLibnames[ I ] ); // - if FRichEditModule > HINSTANCE_ERROR then break; // - RichEditClass := RichEditClasses[ I ]; // - end; // - if FRichEditModule <= HINSTANCE_ERROR then // - FRichEditModule := 0; // - end; // - Flags := MakeFlags( @AOptions, RichEditFlags ); // - CreateCommonControl( AParent, RichEditClass, WS_VISIBLE or WS_CHILD // - or WS_TABSTOP or WS_BORDER or ES_MULTILINE or Flags, // - True, @RichEditActions ); // - // - AttachProc( WndProcRichEditNotify ); // - fDoubleBuffered := False; // - fCannotDoubleBuf := True; // - with fBoundsRect do // - begin // - Right := Right + 100; // - Bottom := Top + 200; // - end; // - fColor := clWindow; // - fLookTabKeys := [ tkTab ]; // - if eoWantTab in AOptions then // - fLookTabKeys := [ ]; // - Perform( EM_SETEVENTMASK, 0, // - ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or // - ENM_PROTECTED or $04000000 {ENM_LINK} ); // - Perform( EM_SETBKGNDCOLOR, 0, Color2RGB(fColor)); // -end; // - // - // -//[constructor TControl.CreateRichEdit] -constructor TControl.CreateRichEdit(AParent: PControl; // - AOptions: TEditOptions); // -var OldRichEditClass, OldRichEditLib: PAnsiChar; // -begin // - if OleInit then // - begin // - OldRichEditClass := RichEditClass; // - OldRichEditLib := RichEditLib; // - CreateRichEdit1( AParent, AOptions ); // - fCharFmtDeltaSz := 24; // - fParaFmtDeltaSz := sizeof( TParaFormat2 ) - sizeof( RichEdit.TParaFormat ); // - RichEditClass := OldRichEditClass; // - RichEditLib := OldRichEditLib; // - end // - else // - CreateRichEdit1( AParent, AOptions ); // -end; // - // -//[constructor TControl.CreateProgressbar] -constructor TControl.CreateProgressbar(AParent: PControl); // -const ProgressBarFlags: array[ TProgressbarOption ] of Integer = // - (PBS_VERTICAL, PBS_SMOOTH ); // -begin // - CreateCommonControl( AParent, PROGRESS_CLASS, // - WS_CHILD or WS_VISIBLE, True, nil ); // - with fBoundsRect do // - begin // - Right := Left + 300; // - Bottom := Top + 20; // - end; // - fMenu := 0; // - fTextColor := clHighlight; // -end; // - // -//[constructor TControl.CreateProgressbarEx] -constructor TControl.CreateProgressbarEx(AParent: PControl; // - AOptions: TProgressbarOptions); // -const ProgressBarFlags: array[ TProgressbarOption ] of Integer = // - (PBS_VERTICAL, PBS_SMOOTH ); // -begin // - CreateProgressbar( AParent ); // - fStyle := fStyle or DWORD( MakeFlags( @AOptions, ProgressBarFlags ) ); // -end; // - // -//[constructor TControl.CreateListView] -constructor TControl.CreateListView(AParent: PControl; // - AStyle: TListViewStyle; AOptions: TListViewOptions; AImageListSmall, // - AImageListNormal, AImageListState: PImageList); // -begin // - CreateCommonControl( AParent, WC_LISTVIEW, ListViewStyles[ AStyle ] or // - LVS_SHAREIMAGELISTS or WS_CHILD or WS_VISIBLE or WS_TABSTOP, // - True, @ListViewActions ); // - fLVOptions := AOptions; // - fLVStyle := AStyle; // - fCreateWndExt := ApplyImageLists2ListView; // - with fBoundsRect do // - begin // - Right := Left + 200; // - Bottom := Top + 150; // - end; // - ImageListSmall := AImageListSmall; // - ImageListNormal := AImageListNormal; // - ImageListState := AImageListState; // - fLVTextBkColor := clWindow; // - fLookTabKeys := [ tkTab ]; // -end; // - // -//[constructor TControl.CreateTreeView] -constructor TControl.CreateTreeView(AParent: PControl; // - AOptions: TTreeViewOptions; AImgListNormal, AImgListState: PImageList); // -var Flags: Integer; // -begin // - Flags := MakeFlags( @AOptions, TreeViewFlags ); // - CreateCommonControl( AParent, WC_TREEVIEW, Flags or WS_VISIBLE or // - WS_CHILD or WS_TABSTOP, True, @TreeViewActions ); // - fCreateWndExt := ApplyImageLists2Control; // - fColor := clWindow; // - AttachProc( WndProcTreeView ); // - with fBoundsRect do // - begin // - Right := Left + 150; // - Bottom := Top + 200; // - end; // - ImageListNormal := AImgListNormal; // - ImageListState := AImgListState; // - fLookTabKeys := [ tkTab ]; // -end; // - // -//[constructor TControl.CreateTabControl] -constructor TControl.CreateTabControl(AParent: PControl; ATabs: array of String;// - AOptions: TTabControlOptions; // - AImgList: PImageList; AImgList1stIdx: Integer); // -var I, II : Integer; // - Flags: Integer; // -begin // - Flags := MakeFlags( @AOptions, TabControlFlags ); // - if tcoFocusTabs in AOptions then // - Flags := Flags or (WS_TABSTOP or TCS_FOCUSONBUTTONDOWN); // - CreateCommonControl( AParent, WC_TABCONTROL, // - Flags or (WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or // - WS_VISIBLE), True, @TabControlActions ); // - if not( tcoBorder in AOptions ) then // - fExStyle := fExStyle and not WS_EX_CLIENTEDGE; // - AttachProc( WndProcTabControl ); // - with fBoundsRect do // - begin // - Right := Left + 100; // - Bottom := Top + 100; // - end; // - if AImgList <> nil then // - Perform( TCM_SETIMAGELIST, 0, AImgList.Handle ); // - II := AImgList1stIdx; // - for I := 0 to High( ATabs ) do // - begin // - TC_Insert( I, ATabs[ I ], II ); // - Inc( II ); // - end; // - fLookTabKeys := [ tkTab ]; // -end; // - // -//[constructor TControl.CreateToolbar] -constructor TControl.CreateToolbar(AParent: PControl; // - AAlign: TControlAlign; AOptions: TToolbarOptions; ABitmap: HBitmap; // - AButtons: array of PAnsiChar; ABtnImgIdxArray: array of Integer); // -var Flags: DWORD; // -begin // - if not( tboTextBottom in AOptions ) then // - AOptions := AOptions + [ tboTextRight ]; // - if tboTextRight in AOptions then // - AOptions := AOptions - [ tboTextBottom ]; // - Flags := MakeFlags( @AOptions, ToolbarOptions ); // - CreateCommonControl( AParent, TOOLBARCLASSNAME, ToolbarAligns[ Align ] or // - WS_CHILD or WS_VISIBLE {or WS_TABSTOP} // - or TBSTYLE_TOOLTIPS or Flags, // - (not (Align in [caNone])) and // - not (tboNoDivider in AOptions), nil ); // - fCommandActions.aClear := ClearToolbar; // - fCommandActions.aGetCount := TB_BUTTONCOUNT; // - with fBoundsRect do // - begin // - if AAlign in [ caNone ] then // - begin // - Bottom := Top + 26; // - Right := Left + 1000; // - end // - else // - begin // - Left := 0; Right := 0; // - Top := 0; Bottom := 0; // - end; // - end; // - Perform(TB_SETEXTENDEDSTYLE, 0, Perform(TB_GETEXTENDEDSTYLE, 0, 0) or // - TBSTYLE_EX_DRAWDDARROWS); // - // - AttachProc( WndProcToolbarCtrl ); // - Perform( TB_BUTTONSTRUCTSIZE, Sizeof( TTBButton ), 0 ); // - Perform( TB_SETINDENT, fMargin, 0 ); // - with fBoundsRect do // - begin // - if AAlign in [ caLeft, caRight ] then // - Right := Left + 24 // - else if not (AAlign in [caNone]) then // - Bottom := Top + 22; // - end; // - if ABitmap <> 0 then // - TBAddBitmap( ABitmap ); // - TBAddButtons( AButtons, ABtnImgIdxArray ); // - Perform( WM_SIZE, 0, 0 ); // -end; // - // -//[constructor TImageList.CreateImageList] -constructor TImageList.CreateImageList(POwner: Pointer); // -var AOwner: PControl; // -begin // - {*************} DoInitCommonControls( ICC_WIN95_CLASSES ); // - Create; // - FAllocBy := 1; // - FMasked := True; // - if POwner = nil then exit; // - FBkColor := TColor( CLR_NONE ); - //ImageList_SetBkColor( FHandle, CLR_NONE ); - // - AOwner := POwner; // - FControl := AOwner; // - fNext := PImageList( AOwner.fImageList ); // - if AOwner.fImageList <> nil then // - PImageList( AOwner.fImageList ).fPrev := @Self; // - AOwner.fImageList := @Self; // -end; // - // -//[constructor TThread.ThreadCreate] -constructor TThread.ThreadCreate; // -begin // - IsMultiThread := True; // - Create; // - FSuspended := True; // - FHandle := CreateThread( nil, // no security // - 0, // the same stack size // - @ThreadFunc, // thread entry point // - @Self, // parameter to pass to ThreadFunc // - CREATE_SUSPENDED, // always SUSPENDED // - FThreadID ); // receive thread ID // -end; // - // -//[constructor TThread.ThreadCreateEx] -constructor TThread.ThreadCreateEx( const Proc: TOnThreadExecute ); // -begin // - ThreadCreate; // - OnExecute := Proc; // - Resume; // -end; // - // -{$ENDIF USE_CONSTRUCTORS} //****************************************************// -{+} - //[procedure InvalidateExW] procedure InvalidateExW( Wnd: HWnd ); begin diff --git a/KOLDEF.inc b/KOLDEF.inc index 887283c..f3848d0 100644 --- a/KOLDEF.inc +++ b/KOLDEF.inc @@ -198,17 +198,6 @@ That is all to have full compatibility. {$ENDIF} {$ENDIF} -//{$DEFINE USE_CONSTRUCTORS} -// Comment this line to produce smaller code if constructors are not used. -// When uncommented, this definition allows to create descendant controls -// and objects overriding constructors, which are actually members of objects. -// Otherwise, global functions (usually named New) are used to -// create and initialize object instances. This gives smaller code, but -// prevents from using OOP inheritance. -// Note: creating descendant objects derived from TObj does not require using -// of this option. It is actually needed only for deriving new controls on -// base of TControl. See also option USE_CUSTOMEXTENSIONS below. - //{$DEFINE USE_CUSTOMEXTENSIONS} // Uncomment this option or add it to your project conditional defines, // if You wish to extend existing TControl object from @@ -218,20 +207,23 @@ That is all to have full compatibility. // directive there. (Search the word: USE_CUSTOMEXTENSIONS). // Please note, that this option is not fully supported now. -//{$IFNDEF NOT_UNLOAD_RICHEDITLIB} -// {$DEFINE UNLOAD_RICHEDITLIB} -//{$ENDIF} +{$IFNDEF NOT_UNLOAD_RICHEDITLIB} + {$DEFINE UNLOAD_RICHEDITLIB} +{$ENDIF} // You can freely comment this directive. 1st, if the application does not // use richedit control. 2nd, even if it does, freeing the library handle // actually is not needed. // Another way to turn this option off is to define symbol NOT_UNLOAD_RICHEDITLIB // in your project options. -{$IFNDEF INPACKAGE} - {$DEFINE NOT_USE_RICHEDIT} -{$ENDIF} +//{$IFNDEF INPACKAGE} +// {$DEFINE NOT_USE_RICHEDIT} +//{$ENDIF} //{$DEFINE TEST_VERSION} {$IFNDEF _D6orHigher} {$DEFINE PARANOIA} //seems not needed under D6 !!! Inprise fixed this, finally... -{$ENDIF} \ No newline at end of file +{$ENDIF} + +// use _SetDIBPixelsTrueColorWithAlpha for 32bit +{$DEFINE FIXDIB32} \ No newline at end of file diff --git a/KOL_ASM.inc b/KOL_ASM.inc index de2b121..82cb5ec 100644 --- a/KOL_ASM.inc +++ b/KOL_ASM.inc @@ -16977,7 +16977,11 @@ asm @@if32bit: LOOP @@iffin INC EDX +{$IFDEF FIXDIB32} + MOV EAX, offset[_GetDIBPixelsTrueColorWithAlpha] +{$ELSE} MOV EAX, offset[_GetDIBPixelsTrueColor] +{$ENDIF} @@iffin: MOV byte ptr [EBX].fPixelMask, DH MOV byte ptr [EBX].fPixelsPerByteMask, DL @@ -17181,7 +17185,11 @@ asm @@if32bit: LOOP @@ifend INC EDX +{$IFDEF FIXDIB32} + MOV EAX, offset[_SetDIBPixelsTrueColorWithAlpha] +{$ELSE} MOV EAX, offset[_SetDIBPixelsTrueColor] +{$ENDIF} @@ifend: MOV byte ptr [EBX].fPixelMask, DH MOV byte ptr [EBX].fPixelsPerByteMask, DL diff --git a/KOLadd.pas b/KOLadd.pas index e928dee..14406b9 100644 --- a/KOLadd.pas +++ b/KOLadd.pas @@ -701,10 +701,6 @@ type function GetTotal: Integer; function GetIndexAmongSiblings: Integer; protected - {$IFDEF USE_CONSTRUCTORS} - constructor CreateTree( AParent: PTree; const AName: AnsiString ); - {* } - {$ENDIF} {++}(*public*){--} destructor Destroy; {-}virtual;{+}{++}(*override;*){--} {* } @@ -2978,14 +2974,6 @@ end; { -- TTree -- } -{$IFDEF USE_CONSTRUCTORS} -//[function NewTree] -function NewTree( AParent: PTree; const AName: AnsiString ): PTree; -begin - New( Result, CreateTree( AParent, AName ) ); -end; -//[END NewTree] -{$ELSE not_USE_CONSTRUCTORS} //[function NewTree] {$IFDEF TREE_NONAME} function NewTree( AParent: PTree ): PTree; @@ -3023,7 +3011,6 @@ end; {$ENDIF} {$ENDIF} //[END NewTree] -{$ENDIF USE_CONSTRUCTORS} { TTree } @@ -3056,18 +3043,6 @@ begin PTree( fChildren.Items[ I ] ).Free; end; -{$IFDEF USE_CONSTRUCTORS} -//[constructor TTree.CreateTree] -constructor TTree.CreateTree(AParent: PTree; const AName: AnsiString); -begin - inherited Create; - if AParent <> nil then - AParent.Add( @Self ); - fParent := AParent; - fName := AName; -end; -{$ENDIF} - //[destructor TTree.Destroy] destructor TTree.Destroy; begin