diff --git a/Addons/KOLCCtrls.pas b/Addons/KOLCCtrls.pas index ba821e9..bd6d283 100644 --- a/Addons/KOLCCtrls.pas +++ b/Addons/KOLCCtrls.pas @@ -166,7 +166,6 @@ type procedure SetWidth(Value: Integer); procedure DoClick(Sender: PObj); procedure SetPath(Value: string); - procedure DoChange(Obj: PObj); protected { Protected declarations } public @@ -203,7 +202,7 @@ type fIntegralHeight: Boolean; fFileList: PDirList; fControl: PControl; - fPath: string; + fPath: KOLString; fFont: PGraphicTool; FOnSelChange: TOnEvent; fDoCase: TCase; @@ -225,7 +224,7 @@ type function GetWidth: Integer; procedure SetWidth(Value: Integer); procedure DoSelChange(Sender: PObj); - procedure SetPath(Value: string); + procedure SetPath(Value: KOLString); procedure SetFilters(Value: string); procedure SetIntegralHeight(Value: Boolean); function GetCurIndex: Integer; @@ -257,7 +256,7 @@ type property Color: TColor read fColor write fColor; property Font: PGraphicTool read GetFont write SetFont; property IntegralHeight: Boolean read fIntegralHeight write SetIntegralHeight; - property Path: string read fPath write SetPath; + property Path: KOLstring read fPath write SetPath; property Filters: string read fFilters write SetFilters; property OnSelChange: TOnEvent read FOnSelChange write FOnSelChange; property OnPaint: TOnPaint read FOnPaint write FOnPaint; @@ -344,7 +343,7 @@ type fInitialized: Integer; fCurIndex: Integer; fControl: PControl; - fDrive: char; + fDrive: KOLChar; fFont: PGraphicTool; fLVBkColor: Integer; fOnChange: TOnEvent; @@ -359,7 +358,7 @@ type procedure SetHeight(Value: Integer); function GetWidth: Integer; procedure SetWidth(Value: Integer); - procedure SetDrive(Value: char); + procedure SetDrive(Value: KOLChar); procedure BuildList; procedure DoChange(Obj: PObj); // procedure DoChangeInternal(Obj: PObj); @@ -378,7 +377,7 @@ type { Public declarations } property DirectoryListBox: PSPCDirectoryList read fDirectoryListBox write fDirectoryListBox; property Font: PGraphicTool read GetFont write SetFont; - property Drive: char read fDrive write SetDrive; + property Drive: KOLChar read fDrive write SetDrive; property CurIndex: Integer read fCurIndex write fCurIndex; property LVBkColor: Integer read fLVBkColor write fLVBkColor; property OnChange: TOnEvent read fOnChange write fOnChange; @@ -684,11 +683,6 @@ begin end; end; -procedure TSPCDirectoryEdit.DoChange; -begin - if Assigned(fOnChange) then fOnChange(@Self); -end; - function TSPCDirectoryEdit.GetHeight: Integer; begin Result := fControl.Height; @@ -838,6 +832,7 @@ begin if fValue[Length(fValue)] = '\' then TPath := fValue else TPath := fValue + '\'; fPath := TPath; fDriveShown := False; + fImgIndex := -1; repeat if fTotalTree > 0 then fImgIndex := 1; if not fDriveShown then begin @@ -958,7 +953,7 @@ end; procedure TSPCDriveCombo.DoChange(Obj: PObj); begin Drive := fControl.Items[fControl.CurIndex][1]; - SetCurrentDirectory(PChar(Drive + ':\')); + SetCurrentDirectory(PKOLChar(Drive + ':\')); if Assigned(fOnChange) then fOnChange(@Self); if Assigned(fDirectoryListBox) then fDirectoryListBox.Path := Drive; end; @@ -1002,7 +997,7 @@ end; procedure TSPCDriveCombo.SetDrive; var - fC : Char; + fC : KOLChar; begin fControl.Font.Assign(fFont); fControl.Color := fColor; @@ -1016,22 +1011,24 @@ begin if Assigned(fOnChange) then if fInitialized = 2 then fOnChange(@Self); end; -function VolumeID(DriveChar: Char): string; +function VolumeID(DriveChar: KOLChar): string; var NotUsed, VolFlags : DWORD; - Buf : array[0..MAX_PATH] of Char; + Buf : array[0..MAX_PATH] of KOLChar; begin - if GetVolumeInformation(PChar(DriveChar + ':\'), Buf, DWORD(sizeof(Buf)), nil, NotUsed, VolFlags, nil, 0) then Result := Copy(Buf, 1, StrLen(Buf)) else + if GetVolumeInformation(PKOLChar(DriveChar + ':\'), Buf, DWORD(sizeof(Buf)), nil, NotUsed, VolFlags, nil, 0) then + Result := buf//Copy(Buf, 1, StrLen(Buf)) + else Result := ''; end; -function dr_property(path: string): string; +function dr_property(path: KOLString): KOLString; var - Cpath : Pchar; - Spath : Char; + Cpath : PKOLChar; + Spath : KOLChar; begin Result := ''; - Cpath := PChar(Copy(path, 1, 2)); + Cpath := PKOLChar(Copy(path, 1, 2)); Spath := Cpath[0]; case GetDriveType(Cpath) of 0: Result := ''; //Не известен @@ -1107,7 +1104,7 @@ begin end; Ico := FileIconSystemIdx(PControl(Sender).Items[ItemIdx][1] + ':\'); fIcons.Draw(Ico, DC, Rect.Left + 1, Rect.Top); - DrawText(DC, PChar(PControl(Sender).Items[ItemIdx]), Length(PControl(Sender).Items[ItemIdx]), T_Rect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); + DrawText(DC, PKOLChar(PControl(Sender).Items[ItemIdx]), Length(PControl(Sender).Items[ItemIdx]), T_Rect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); end; // PControl(Sender).Update; Result := True; /// @@ -1228,7 +1225,7 @@ begin fControl.Font.Assign(Value); end; -procedure TSPCFileList.SetPath(Value: string); +procedure TSPCFileList.SetPath(Value: KOLstring); var i : Integer; fValue : string; @@ -1434,7 +1431,7 @@ begin end; Ico := FileIconSystemIdx(Path + PControl(Sender).Items[ItemIdx]); fIcons.Draw(Ico, DC, Rect.Left + 1, Rect.Top); - DrawText(DC, PChar(PControl(Sender).Items[ItemIdx]), Length(PControl(Sender).Items[ItemIdx]), T_Rect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); + DrawText(DC, PKOLChar(PControl(Sender).Items[ItemIdx]), Length(PControl(Sender).Items[ItemIdx]), T_Rect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX); end; PControl(Sender).Update; Result := True; /// @@ -1442,7 +1439,14 @@ end; procedure TSPCFileList.DoMouseDblClk(Sender: PControl; var Mouse: TMouseEventData); begin - if ExecuteOnDblClk then ShellExecuteA(fControl.Handle, nil, PChar(Path + Sender.Items[CurIndex]), '', '', SW_SHOW) else + if ExecuteOnDblClk then + {$IFDEF UNICODE_CTRLS} + ShellExecuteW + {$ELSE} + ShellExecuteA + {$ENDIF} + (fControl.Handle, nil, PKOLChar(Path + Sender.Items[CurIndex]), '', '', SW_SHOW) + else if Assigned(fOnMouseDblClick) then fOnMouseDblClick(@Self, Mouse); end; @@ -1669,7 +1673,7 @@ var begin Style := $00000000; Style := Style or WS_VISIBLE or WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; //msctls_statusbar32 - c := _NewControl(AOwner, PChar('msctls_statusbar32'), Style, True, nil); + c := _NewControl(AOwner, 'msctls_statusbar32', Style, True, nil); // c:=_NewStatusBar(AOwner); c.Style := Style; c.ExStyle := c.ExStyle xor WS_EX_CLIENTEDGE; diff --git a/Addons/KOLEcmListEdit.pas b/Addons/KOLEcmListEdit.pas index 6bb2ec0..c1fb7f0 100644 --- a/Addons/KOLEcmListEdit.pas +++ b/Addons/KOLEcmListEdit.pas @@ -195,7 +195,7 @@ type fInPlaceEd: PControl; bComboEditor: Boolean; ComboOptions: TComboOptions; - ComboText: string; + ComboText: KOLString; destructor Destroy; virtual; // Do not call this destructor. Use Free method instead. procedure SetCurLVPos(ALine, AIdx: Integer); procedure StartEdit; diff --git a/Addons/KOLGRushControls.pas b/Addons/KOLGRushControls.pas index a5e3ced..bb0ecd9 100644 --- a/Addons/KOLGRushControls.pas +++ b/Addons/KOLGRushControls.pas @@ -1,4 +1,6 @@ unit KOLGRushControls; +//!! this version is compatible with KOL 3.00+ !! -- by V.K. + {* |GRushControls - Controls set with high quality of visulation and effects. | @@ -1062,7 +1064,8 @@ end; procedure ClickGRushRadio( Sender:PObj ); begin - PGRushControl( Sender ).fChecked := TRUE; + {$IFDEF USE_FLAGS} include( PGrushControl( Sender ).fFlagsG4, G4_Checked ); + {$ELSE} PGRushControl( Sender ).fChecked := TRUE; {$ENDIF} end; {$IFDEF FIX_DRAWTRANSPARENT} @@ -1315,6 +1318,8 @@ var yDest: integer; Delta: DWORD; {$ENDIF USE_MMX} begin + if DstBitmap.DIBBits = nil then Exit; + if SrcBitmap.DIBBits = nil then Exit; {$IFDEF USE_MMX} if UseMMX then begin SrcBits := DWORD(SrcBitmap.DIBBits); @@ -1428,6 +1433,11 @@ var Factor2: byte; _Top: DWORD; {$ENDIF USE_MMX} begin + if DestBitmap.DIBBits = nil then Exit; + if FromBitmap.DIBBits = nil then Exit; + if ToBitmap.DIBBits = nil then Exit; + if ClipRect.Left >= ClipRect.Right then Exit; + if ClipRect.Top >= ClipRect.Bottom then Exit; {$IFDEF USE_MMX} if UseMMX then begin _Top := FromBitmap.Width * 4 * ClipRect.Top + ClipRect.Left * 4; @@ -2372,14 +2382,17 @@ begin case Msg.message of BM_GETCHECK: begin - //if Data.fControlType in [ctCheckBox, ctRadioBox] then - Rslt := Integer(Ctl_.fChecked); + Rslt := {$IFDEF USE_FLAGS} Integer( G4_Checked in Ctl_.fFlagsG4 ) + {$ELSE} Integer(Ctl_.fChecked) {$ENDIF}; Result := TRUE; end; BM_SETCHECK: {+/-}//if Data.fControlType in [ctCheckBox, ctRadioBox] then begin - Ctl_.fChecked := Boolean(Msg.wParam); + {$IFDEF USE_FLAGS} if Boolean(Msg.wParam) then + include( Ctl_.fFlagsG4, G4_Checked ) + else exclude( Ctl_.fFlagsG4, G4_Checked ); + {$ELSE} Ctl_.fChecked := Boolean(Msg.wParam); {$ENDIF} if Boolean(Msg.wParam) then Ctl_.DeactivateSublings; Ctl_.Invalidate; @@ -2508,7 +2521,7 @@ begin begin if (Data.fStateInit = siKey) then begin Data.fStateInit := siButton; - PGRushControl(Ctl_).fOnMouseLeave(Ctl_); + PGRushControl(Ctl_).EV.fOnMouseLeave(Ctl_); Data.fStateInit := siNone; end; Data.fActive := false; @@ -3110,8 +3123,10 @@ begin {$ELSE NOT_IMMIDIATLYONLY} TimerEvent(PGRushData(CustomObj)); {$ENDIF NOT_IMMIDIATLYONLY} - if assigned(fOnClick) then - fOnClick(@Self); + {$IFDEF NIL_EVENTS} + if assigned(EV.fOnClick) then + {$ENDIF} + EV.fOnClick(@Self); end; end; @@ -3170,13 +3185,12 @@ end; function NewGRushButton; begin Result := PGRushControl(_NewControl( AParent, 'GRUSH_BUTTON', WS_VISIBLE - or WS_CHILD or WS_TABSTOP, False, @ButtonActions )); - //Result.ClsStyle := Result.ClsStyle or CS_PARENTDC; + or WS_CHILD or WS_TABSTOP, False, + {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed + {$ELSE} @ButtonActions {$ENDIF} )); Result.Caption := Caption; - Result.fCommandActions.aAutoSzX := 12; - Result.fCommandActions.aAutoSzY := 11; - - + Result.aAutoSzX := 12; + Result.aAutoSzY := 11; Result.InitLast(TRUE, ctButton); {$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER} Result.AttachProc( WndProcBtnReturnClick ); @@ -3187,7 +3201,9 @@ end; function NewGRushPanel; begin Result := PGRushControl(_NewControl( AParent, 'GRUSH_PANEL' - , WS_VISIBLE or WS_CHILD, False, @LabelActions )); + , WS_VISIBLE or WS_CHILD, False, + {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed + {$ELSE} @LabelActions {$ENDIF} )); Result.InitLast(FALSE, ctPanel); Result.All_TextVAlign := vaTop; @@ -3198,10 +3214,13 @@ begin if CheckRgn = 0 then CheckRgn := RegionFromArray(_Check); Result := PGRushControl(_NewControl( AParent, 'GRUSH_CHECKBOX', WS_VISIBLE - or WS_CHILD or WS_TABSTOP, False, @ButtonActions )); + or WS_CHILD or WS_TABSTOP, False, + {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed + {$ELSE} @ButtonActions {$ENDIF})); Result.Caption := Caption; - Result.fIgnoreDefault := TRUE; - Result.fCommandActions.aAutoSzX := 24; + {$IFDEF USE_FLAGS} include( Result.fFlagsG5, G5_IgnoreDefault ); + {$ELSE} Result.fIgnoreDefault := TRUE; {$ENDIF} + Result.aAutoSzX := 24; Result.InitLast(TRUE, ctCheckBox); Result.All_BorderRoundWidth := 0; @@ -3210,14 +3229,17 @@ end; function NewGRushRadioBox; begin - if RadioRgn = 0 then + if RadioRgn = 0 then RadioRgn := RegionFromArray(_Radio); Result := PGRushControl(_NewControl( AParent, 'GRUSH_RADIOBOX', WS_VISIBLE - or WS_CHILD or WS_TABSTOP, False, @ButtonActions )); - Result.fControlClick := ClickGRushRadio; - Result.fCommandActions.aAutoSzX := 24; + or WS_CHILD or WS_TABSTOP, False, + {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed + {$ELSE} @ButtonActions {$ENDIF})); + Result.PP.fControlClick := ClickGRushRadio; + Result.aAutoSzX := 24; Result.Caption := Caption; - Result.fIgnoreDefault := TRUE; + {$IFDEF USE_FLAGS} include( Result.fFlagsG5, G5_IgnoreDefault ); + {$ELSE} Result.fIgnoreDefault := TRUE; {$ENDIF} Result.InitLast(TRUE, ctRadioBox); Result.All_BorderRoundWidth := 50; @@ -3258,7 +3280,9 @@ function NewGRushProgressBar; var Data: PGRushData; begin Result := PGRushControl(_NewControl( AParent, 'GRUSH_PROGRESSBAR' - , WS_VISIBLE or WS_CHILD, False, @LabelActions )); + , WS_VISIBLE or WS_CHILD, False, + {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed + {$ELSE} @LabelActions {$ENDIF} )); Result.InitLast(FALSE, ctProgressBar); Data := PGRushData(Result.CustomObj); diff --git a/Addons/KOLMHToolTip.pas b/Addons/KOLMHToolTip.pas index a98c379..87620dd 100644 --- a/Addons/KOLMHToolTip.pas +++ b/Addons/KOLMHToolTip.pas @@ -43,8 +43,7 @@ uses Windows, KOL, Messages; type {$ENDIF Frame} -{$IFDEF interface} - +{$IFDEF interface_part} TFE = (eTextColor, eBkColor, eAPDelay, eRDelay, eIDelay); @@ -60,14 +59,14 @@ type PMHToolTip = ^TMHToolTip; TKOLMHToolTip = PMHToolTip; -{$ENDIF interface} +{$ENDIF interface_part} {$IFDEF pre_interface} PMHHint = ^TMHHint; TKOLMHHint = PMHHint; {$ENDIF pre_interface} -{$IFDEF interface} +{$IFDEF interface_part} TMHToolTipManager = object(TObj) protected @@ -79,6 +78,7 @@ type function CreateNeed(FI: TFI): PMHToolTip; end; + //P_MHHint = ^TMHHint; TMHHint = object(TObj) private function GetManager:PMHToolTipManager; @@ -191,7 +191,7 @@ function NewMHToolTip(AParent: PControl): PMHToolTip; var Manager: PMHToolTipManager; -{$ENDIF interface} +{$ENDIF interface_part} {$IFDEF Frame} @@ -214,21 +214,18 @@ const Result := False;} //end; - - function NewMHToolTip(AParent: PControl): PMHToolTip; //var // Data: PDateTimePickerData; // T: TWndClassEx; -// a: integer; +//var a: integer; const CS_DROPSHADOW = $00020000; begin DoInitCommonControls(ICC_BAR_CLASSES); New(Result, Create); - Result.fHandle := CreateWindowEx(0, TOOLTIPS_CLASS, '', 0, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, AParent.Handle, 0, HInstance, nil); - + Result.fHandle := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, '', 0, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, AParent.GetWindowHandle, 0, HInstance, nil); // SetClassLong(Result.handle,GCL_STYLE,CS_DROPSHADOW); // Result := PMHToolTip(_NewControl(AParent, TOOLTIPS_CLASS, 0, False, 0)); //PMHToolTip(_NewCommonControl(AParent,TOOLTIPS_CLASS, 0{TTS_ALWAYSTIP}{WS_CHILD or WS_VISIBLE},False,0)); @@ -378,7 +375,7 @@ end; procedure TMHToolTip.Popup; begin - SendMessage(fHandle, TTM_POPUP, 0, 0); + SendMessage(fHandle, $0422 {TTM_POPUP}, 0, 0); end; {function TMHToolTip.GetText: string; @@ -451,6 +448,7 @@ begin ToolTip := nil; // ??? HasTool := False; // ??? end; + A.Add2AutoFree(Result); end; function NewManager: PMHToolTipManager; @@ -593,11 +591,7 @@ begin with TI do begin - uFlags := TTF_SUBCLASS; // Spec - //rect := Parent.ClientRect; // Spec - rect := MakeRect( 0, 0, 2048, 1600 ); - // это ничему не мешает, и обеспечивает независимость от размера контрола, - // который может изменяться в процессе работы + uFlags := TTF_SUBCLASS or TTF_IDISHWND; // Spec lpszText := PKOLChar(Value); // Spec end; @@ -827,6 +821,7 @@ end; destructor TMHHint.Destroy; var TI: TToolInfo; + i: integer; begin with TI do begin @@ -837,7 +832,15 @@ begin SendMessage(ToolTip.handle, TTM_DELTOOL, 0, DWORD(@TI)); ToolTip.Count := ToolTip.Count - 1; - Manager.Free; + if ToolTip.Count <= 0 then begin + i:=Length(Manager.TTT); + if i > 1 then begin + Manager.TTT[i - 1].Free; + SetLength(Manager.TTT, i - 1); + end + else + Free_And_Nil(Manager); + end; inherited; end; @@ -931,9 +934,4 @@ function GetHint: PMHHint; {$IFDEF var} fHint: PMHHint; - {$ENDIF var} - - - - - + {$ENDIF var} \ No newline at end of file diff --git a/Addons/KOLQProgBar.pas b/Addons/KOLQProgBar.pas index a01c1fb..c36f704 100644 --- a/Addons/KOLQProgBar.pas +++ b/Addons/KOLQProgBar.pas @@ -1,3 +1,4 @@ +{$I KOLDEF.inc} unit KOLQProgBar; { @@ -111,6 +112,7 @@ unit KOLQProgBar; |

} interface + // ---------------------------------------------------------- uses Windows, Messages, KOL; @@ -489,7 +491,7 @@ var Data: PQDataObj; begin Result := PQProgressBar( _NewControl( AParent, 'QProgressBar', - WS_VISIBLE + WS_CHILD + SS_NOTIFY, False, @LabelActions ) ); + WS_VISIBLE + WS_CHILD + SS_NOTIFY, False, {$IFDEF PACK_COMMANDACTIONS}@LabelActions_Packed{$ELSE}@LabelActions{$ENDIF} ) ); New( Data, Create ); // releases authomatically when the object destroys Result.CustomObj := Data; diff --git a/Addons/KOLReport.pas b/Addons/KOLReport.pas index 76c1f94..0e7b101 100644 --- a/Addons/KOLReport.pas +++ b/Addons/KOLReport.pas @@ -464,7 +464,7 @@ begin Result.OnPaint := TOnPaint( MakeMethod( Result, @ PaintFrames ) ); Result.Width := 400; Result.Height := 40; - Result.fCommandActions.aAutoSzX := 12; + Result.aAutoSzX := 12; end; procedure InitBandLabel( L: PControl; Frames: TFrames ); @@ -478,7 +478,7 @@ begin Data.Paddings.LeftPadding := 4; Data.Paddings.RightPadding := 4; L.OnPaint := TOnPaint( MakeMethod( L, @ PaintFrames ) ); - L.fCommandActions.aAutoSzX := 12; + L.aAutoSzX := 12; end; function NewReportLabel( AParent: PControl; const Caption: String; Frames: TFrames ): PControl; @@ -503,8 +503,7 @@ begin Data.Paddings.TopPadding := TopPadding; Data.Paddings.RightPadding := RightPadding; Data.Paddings.BottomPadding := BottomPadding; - BandCtl.fCommandActions.aAutoSzX := BandCtl.fCommandActions.aAutoSzX - - WasHPadding + LeftPadding + RightPadding; + BandCtl.aAutoSzX := BandCtl.aAutoSzX - WasHPadding + LeftPadding + RightPadding; if BandCtl.IsAutoSize then BandCtl.AutoSize( TRUE ); end; diff --git a/Addons/MCKGRushButtonEditor.pas b/Addons/MCKGRushButtonEditor.pas index fb53149..8e62daa 100644 --- a/Addons/MCKGRushButtonEditor.pas +++ b/Addons/MCKGRushButtonEditor.pas @@ -266,19 +266,19 @@ begin Result.ButtonOK := PGRushControl(NewGRushButton(Result.Form, 'OK').SetPosition(272, 480).SetSize(105, 33)); Result.ButtonOK.Font.FontStyle := [fsBold]; Result.GRushButton15 := PGRushControl(NewGRushButton(Result.Form, 'Reset to souce').SetPosition(401, 408).SetSize(104, 17)); - //Result.GRushButton15.Font.FontHeight := 8; + Result.GRushButton15.Font.FontHeight := 8; Result.GRushButton15.All_BorderRoundWidth := 0; Result.GRushButton15.All_BorderRoundHeight := 0; Result.GRushButton15.Down_BorderWidth := 1; Result.GRushButton15.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton20 := PGRushControl(NewGRushButton(Result.Form, 'Reset to default').SetPosition(273, 408).SetSize(104, 17)); - //Result.GRushButton20.Font.FontHeight := 8; + Result.GRushButton20.Font.FontHeight := 8; Result.GRushButton20.All_BorderRoundWidth := 0; Result.GRushButton20.All_BorderRoundHeight := 0; Result.GRushButton20.Down_BorderWidth := 1; Result.GRushButton20.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.StatesList := NewComboBox(Result.Form, [coReadOnly, coNoIntegralHeight]).SetPosition(328, 10).SetSize(113, 0); - //Result.StatesList.Font.FontHeight := 8; + Result.StatesList.Font.FontHeight := 8; Result.StatesList.Color := clWindow; Result.StatesList.Items[0] := 'All states (w/o)'; Result.StatesList.Items[1] := 'Default state'; @@ -348,98 +348,98 @@ begin Result.Label31.Color := $E8D6CE; Result.B := NewEditBox(Result.GRushPanel1, []).SetPosition(208, 272).SetSize(33, 17); Result.B.Ctl3D := False; - //Result.B.Font.FontHeight := 8; + Result.B.Font.FontHeight := 8; Result.B.Text := '0'; Result.GlyphHeight := NewEditBox(Result.GRushPanel1, []).SetPosition(200, 224).SetSize(41, 17); Result.GlyphHeight.Ctl3D := False; - //Result.GlyphHeight.Font.FontHeight := 8; + Result.GlyphHeight.Font.FontHeight := 8; Result.GlyphHeight.Text := '0'; Result.GlyphWidth := NewEditBox(Result.GRushPanel1, []).SetPosition(80, 224).SetSize(41, 17); Result.GlyphWidth.Ctl3D := False; - //Result.GlyphWidth.Font.FontHeight := 8; + Result.GlyphWidth.Font.FontHeight := 8; Result.GlyphWidth.Text := '0'; Result.L := NewEditBox(Result.GRushPanel1, []).SetPosition(28, 272).SetSize(33, 17); Result.L.Ctl3D := False; - //Result.L.Font.FontHeight := 8; + Result.L.Font.FontHeight := 8; Result.L.Text := '0'; Result.R := NewEditBox(Result.GRushPanel1, []).SetPosition(148, 272).SetSize(33, 17); Result.R.Ctl3D := False; - //Result.R.Font.FontHeight := 8; + Result.R.Font.FontHeight := 8; Result.R.Text := '0'; Result.Spacing := NewEditBox(Result.GRushPanel1, []).SetPosition(112, 296).SetSize(81, 17); Result.Spacing.Ctl3D := False; - //Result.Spacing.Font.FontHeight := 8; + Result.Spacing.Font.FontHeight := 8; Result.Spacing.Text := '0'; Result.T := NewEditBox(Result.GRushPanel1, []).SetPosition(88, 272).SetSize(33, 17); Result.T.Ctl3D := False; - //Result.T.Font.FontHeight := 8; + Result.T.Font.FontHeight := 8; Result.T.Text := '0'; Result.GRushButton11 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 104).SetSize(41, 17)); - //Result.GRushButton11.Font.FontHeight := 8; + Result.GRushButton11.Font.FontHeight := 8; Result.GRushButton11.All_BorderRoundWidth := 0; Result.GRushButton11.All_BorderRoundHeight := 0; Result.GRushButton11.Down_BorderWidth := 1; Result.GRushButton11.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton12 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 152).SetSize(41, 17)); - //Result.GRushButton12.Font.FontHeight := 8; + Result.GRushButton12.Font.FontHeight := 8; Result.GRushButton12.All_BorderRoundWidth := 0; Result.GRushButton12.All_BorderRoundHeight := 0; Result.GRushButton12.Down_BorderWidth := 1; Result.GRushButton12.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton13 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 200).SetSize(41, 17)); - //Result.GRushButton13.Font.FontHeight := 8; + Result.GRushButton13.Font.FontHeight := 8; Result.GRushButton13.All_BorderRoundWidth := 0; Result.GRushButton13.All_BorderRoundHeight := 0; Result.GRushButton13.Down_BorderWidth := 1; Result.GRushButton13.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton16 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 248).SetSize(41, 17)); - //Result.GRushButton16.Font.FontHeight := 8; + Result.GRushButton16.Font.FontHeight := 8; Result.GRushButton16.All_BorderRoundWidth := 0; Result.GRushButton16.All_BorderRoundHeight := 0; Result.GRushButton16.Down_BorderWidth := 1; Result.GRushButton16.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton17 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 296).SetSize(41, 17)); - //Result.GRushButton17.Font.FontHeight := 8; + Result.GRushButton17.Font.FontHeight := 8; Result.GRushButton17.All_BorderRoundWidth := 0; Result.GRushButton17.All_BorderRoundHeight := 0; Result.GRushButton17.Down_BorderWidth := 1; Result.GRushButton17.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton19 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 320).SetSize(41, 17)); - //Result.GRushButton19.Font.FontHeight := 8; + Result.GRushButton19.Font.FontHeight := 8; Result.GRushButton19.All_BorderRoundWidth := 0; Result.GRushButton19.All_BorderRoundHeight := 0; Result.GRushButton19.Down_BorderWidth := 1; Result.GRushButton19.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GlyphHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 126).SetSize(57, 0); - //Result.GlyphHorz.Font.FontHeight := 8; + Result.GlyphHorz.Font.FontHeight := 8; Result.GlyphHorz.Color := clWindow; Result.GlyphHorz.Items[0] := 'Left'; Result.GlyphHorz.Items[1] := 'Center'; Result.GlyphHorz.Items[2] := 'Right'; Result.GlyphHorz.CurIndex := 0; Result.GlyphVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 126).SetSize(57, 0); - //Result.GlyphVert.Font.FontHeight := 8; + Result.GlyphVert.Font.FontHeight := 8; Result.GlyphVert.Color := clWindow; Result.GlyphVert.Items[0] := 'Top'; Result.GlyphVert.Items[1] := 'Center'; Result.GlyphVert.Items[2] := 'Bottom'; Result.GlyphVert.CurIndex := 0; Result.TextHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 174).SetSize(57, 0); - //Result.TextHorz.Font.FontHeight := 8; + Result.TextHorz.Font.FontHeight := 8; Result.TextHorz.Color := clWindow; Result.TextHorz.Items[0] := 'Left'; Result.TextHorz.Items[1] := 'Center'; Result.TextHorz.Items[2] := 'Right'; Result.TextHorz.CurIndex := 0; Result.TextVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 174).SetSize(57, 0); - //Result.TextVert.Font.FontHeight := 8; + Result.TextVert.Font.FontHeight := 8; Result.TextVert.Color := clWindow; Result.TextVert.Items[0] := 'Top'; Result.TextVert.Items[1] := 'Center'; Result.TextVert.Items[2] := 'Bottom'; Result.TextVert.CurIndex := 0; Result.UpdateSpeed := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(112, 318).SetSize(81, 21); - //Result.UpdateSpeed.Font.FontHeight := 8; + Result.UpdateSpeed.Font.FontHeight := 8; Result.UpdateSpeed.Color := clWindow; Result.UpdateSpeed.Items[0] := 'Immediately'; Result.UpdateSpeed.Items[1] := 'Very fast'; @@ -608,114 +608,114 @@ begin Result.BorderHe := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 272).SetSize(41, 17); Result.BorderHe.Ctl3D := False; Result.BorderHe.Font.FontStyle := []; - //Result.BorderHe.Font.FontHeight := 8; + Result.BorderHe.Font.FontHeight := 8; Result.BorderWi := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 272).SetSize(41, 17); Result.BorderWi.Ctl3D := False; Result.BorderWi.Font.FontStyle := []; - //Result.BorderWi.Font.FontHeight := 8; + Result.BorderWi.Font.FontHeight := 8; Result.BorderWidth := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 200).SetSize(81, 17); Result.BorderWidth.Ctl3D := False; Result.BorderWidth.Font.FontStyle := []; - //Result.BorderWidth.Font.FontHeight := 8; + Result.BorderWidth.Font.FontHeight := 8; Result.GlyphX := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 320).SetSize(41, 17); Result.GlyphX.Ctl3D := False; Result.GlyphX.Font.FontStyle := []; - //Result.GlyphX.Font.FontHeight := 8; + Result.GlyphX.Font.FontHeight := 8; Result.GlyphY := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 320).SetSize(41, 17); Result.GlyphY.Ctl3D := False; Result.GlyphY.Font.FontStyle := []; - //Result.GlyphY.Font.FontHeight := 8; + Result.GlyphY.Font.FontHeight := 8; Result.ShadowOffset := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 224).SetSize(81, 17); Result.ShadowOffset.Ctl3D := False; Result.ShadowOffset.Font.FontStyle := []; - //Result.ShadowOffset.Font.FontHeight := 8; + Result.ShadowOffset.Font.FontHeight := 8; Result.GRushButton1 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 32).SetSize(41, 17)); Result.GRushButton1.Font.FontStyle := []; - //Result.GRushButton1.Font.FontHeight := 8; + Result.GRushButton1.Font.FontHeight := 8; Result.GRushButton1.All_BorderRoundWidth := 0; Result.GRushButton1.All_BorderRoundHeight := 0; Result.GRushButton1.Down_BorderWidth := 1; Result.GRushButton1.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton10 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 296).SetSize(41, 17)); Result.GRushButton10.Font.FontStyle := []; - //Result.GRushButton10.Font.FontHeight := 8; + Result.GRushButton10.Font.FontHeight := 8; Result.GRushButton10.All_BorderRoundWidth := 0; Result.GRushButton10.All_BorderRoundHeight := 0; Result.GRushButton10.Down_BorderWidth := 1; Result.GRushButton10.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton14 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Reset state').SetPosition(176, 4).SetSize(65, 17)); Result.GRushButton14.Font.FontStyle := []; - //Result.GRushButton14.Font.FontHeight := 8; + Result.GRushButton14.Font.FontHeight := 8; Result.GRushButton14.All_BorderRoundWidth := 0; Result.GRushButton14.All_BorderRoundHeight := 0; Result.GRushButton14.Down_BorderWidth := 1; Result.GRushButton14.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton18 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 176).SetSize(41, 17)); Result.GRushButton18.Font.FontStyle := []; - //Result.GRushButton18.Font.FontHeight := 8; + Result.GRushButton18.Font.FontHeight := 8; Result.GRushButton18.All_BorderRoundWidth := 0; Result.GRushButton18.All_BorderRoundHeight := 0; Result.GRushButton18.Down_BorderWidth := 1; Result.GRushButton18.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton2 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 56).SetSize(41, 17)); Result.GRushButton2.Font.FontStyle := []; - //Result.GRushButton2.Font.FontHeight := 8; + Result.GRushButton2.Font.FontHeight := 8; Result.GRushButton2.All_BorderRoundWidth := 0; Result.GRushButton2.All_BorderRoundHeight := 0; Result.GRushButton2.Down_BorderWidth := 1; Result.GRushButton2.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton3 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 80).SetSize(41, 17)); Result.GRushButton3.Font.FontStyle := []; - //Result.GRushButton3.Font.FontHeight := 8; + Result.GRushButton3.Font.FontHeight := 8; Result.GRushButton3.All_BorderRoundWidth := 0; Result.GRushButton3.All_BorderRoundHeight := 0; Result.GRushButton3.Down_BorderWidth := 1; Result.GRushButton3.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton4 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 104).SetSize(41, 17)); Result.GRushButton4.Font.FontStyle := []; - //Result.GRushButton4.Font.FontHeight := 8; + Result.GRushButton4.Font.FontHeight := 8; Result.GRushButton4.All_BorderRoundWidth := 0; Result.GRushButton4.All_BorderRoundHeight := 0; Result.GRushButton4.Down_BorderWidth := 1; Result.GRushButton4.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton5 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 128).SetSize(41, 17)); Result.GRushButton5.Font.FontStyle := []; - //Result.GRushButton5.Font.FontHeight := 8; + Result.GRushButton5.Font.FontHeight := 8; Result.GRushButton5.All_BorderRoundWidth := 0; Result.GRushButton5.All_BorderRoundHeight := 0; Result.GRushButton5.Down_BorderWidth := 1; Result.GRushButton5.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton6 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 152).SetSize(41, 17)); Result.GRushButton6.Font.FontStyle := []; - //Result.GRushButton6.Font.FontHeight := 8; + Result.GRushButton6.Font.FontHeight := 8; Result.GRushButton6.All_BorderRoundWidth := 0; Result.GRushButton6.All_BorderRoundHeight := 0; Result.GRushButton6.Down_BorderWidth := 1; Result.GRushButton6.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton7 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 200).SetSize(41, 17)); Result.GRushButton7.Font.FontStyle := []; - //Result.GRushButton7.Font.FontHeight := 8; + Result.GRushButton7.Font.FontHeight := 8; Result.GRushButton7.All_BorderRoundWidth := 0; Result.GRushButton7.All_BorderRoundHeight := 0; Result.GRushButton7.Down_BorderWidth := 1; Result.GRushButton7.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton8 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 224).SetSize(41, 17)); Result.GRushButton8.Font.FontStyle := []; - //Result.GRushButton8.Font.FontHeight := 8; + Result.GRushButton8.Font.FontHeight := 8; Result.GRushButton8.All_BorderRoundWidth := 0; Result.GRushButton8.All_BorderRoundHeight := 0; Result.GRushButton8.Down_BorderWidth := 1; Result.GRushButton8.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton9 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 248).SetSize(41, 17)); Result.GRushButton9.Font.FontStyle := []; - //Result.GRushButton9.Font.FontHeight := 8; + Result.GRushButton9.Font.FontHeight := 8; Result.GRushButton9.All_BorderRoundWidth := 0; Result.GRushButton9.All_BorderRoundHeight := 0; Result.GRushButton9.Down_BorderWidth := 1; Result.GRushButton9.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GradStyles := NewComboBox(Result.GRushPanel2, [coReadOnly, coNoIntegralHeight]).SetPosition(112, 174).SetSize(81, 0); Result.GradStyles.Font.FontStyle := []; - //Result.GradStyles.Font.FontHeight := 8; + Result.GradStyles.Font.FontHeight := 8; Result.GradStyles.Color := clWindow; Result.GradStyles.Items[0] := 'Solid'; Result.GradStyles.Items[1] := 'Vertical'; diff --git a/Addons/MCKGRushCheckBoxEditor.pas b/Addons/MCKGRushCheckBoxEditor.pas index 28c9782..8ebf151 100644 --- a/Addons/MCKGRushCheckBoxEditor.pas +++ b/Addons/MCKGRushCheckBoxEditor.pas @@ -278,19 +278,19 @@ begin Result.ButtonOK := PGRushControl(NewGRushButton(Result.Form, 'OK').SetPosition(272, 504).SetSize(105, 33)); Result.ButtonOK.Font.FontStyle := [fsBold]; Result.GRushButton15 := PGRushControl(NewGRushButton(Result.Form, 'Reset to souce').SetPosition(401, 408).SetSize(104, 17)); - //Result.GRushButton15.Font.FontHeight := 8; + Result.GRushButton15.Font.FontHeight := 8; Result.GRushButton15.All_BorderRoundWidth := 0; Result.GRushButton15.All_BorderRoundHeight := 0; Result.GRushButton15.Down_BorderWidth := 1; Result.GRushButton15.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton20 := PGRushControl(NewGRushButton(Result.Form, 'Reset to default').SetPosition(273, 408).SetSize(104, 17)); - //Result.GRushButton20.Font.FontHeight := 8; + Result.GRushButton20.Font.FontHeight := 8; Result.GRushButton20.All_BorderRoundWidth := 0; Result.GRushButton20.All_BorderRoundHeight := 0; Result.GRushButton20.Down_BorderWidth := 1; Result.GRushButton20.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.StatesList := NewComboBox(Result.Form, [coReadOnly, coNoIntegralHeight]).SetPosition(328, 10).SetSize(113, 0); - //Result.StatesList.Font.FontHeight := 8; + Result.StatesList.Font.FontHeight := 8; Result.StatesList.Color := clWindow; Result.StatesList.Items[0] := 'All states (w/o)'; Result.StatesList.Items[1] := 'Default state'; @@ -368,113 +368,113 @@ begin Result.Label33.Color := $E8D6CE; Result.B := NewEditBox(Result.GRushPanel1, []).SetPosition(208, 320).SetSize(33, 17); Result.B.Ctl3D := False; - //Result.B.Font.FontHeight := 8; + Result.B.Font.FontHeight := 8; Result.B.Text := '0'; Result.CheckMetric := NewEditBox(Result.GRushPanel1, []).SetPosition(112, 128).SetSize(81, 17); Result.CheckMetric.Ctl3D := False; - //Result.CheckMetric.Font.FontHeight := 8; + Result.CheckMetric.Font.FontHeight := 8; Result.GlyphHeight := NewEditBox(Result.GRushPanel1, []).SetPosition(200, 272).SetSize(41, 17); Result.GlyphHeight.Ctl3D := False; - //Result.GlyphHeight.Font.FontHeight := 8; + Result.GlyphHeight.Font.FontHeight := 8; Result.GlyphHeight.Text := '0'; Result.GlyphWidth := NewEditBox(Result.GRushPanel1, []).SetPosition(80, 272).SetSize(41, 17); Result.GlyphWidth.Ctl3D := False; - //Result.GlyphWidth.Font.FontHeight := 8; + Result.GlyphWidth.Font.FontHeight := 8; Result.GlyphWidth.Text := '0'; Result.L := NewEditBox(Result.GRushPanel1, []).SetPosition(28, 320).SetSize(33, 17); Result.L.Ctl3D := False; - //Result.L.Font.FontHeight := 8; + Result.L.Font.FontHeight := 8; Result.L.Text := '0'; Result.R := NewEditBox(Result.GRushPanel1, []).SetPosition(148, 320).SetSize(33, 17); Result.R.Ctl3D := False; - //Result.R.Font.FontHeight := 8; + Result.R.Font.FontHeight := 8; Result.R.Text := '0'; Result.Spacing := NewEditBox(Result.GRushPanel1, []).SetPosition(112, 344).SetSize(81, 17); Result.Spacing.Ctl3D := False; - //Result.Spacing.Font.FontHeight := 8; + Result.Spacing.Font.FontHeight := 8; Result.Spacing.Text := '0'; Result.T := NewEditBox(Result.GRushPanel1, []).SetPosition(88, 320).SetSize(33, 17); Result.T.Ctl3D := False; - //Result.T.Font.FontHeight := 8; + Result.T.Font.FontHeight := 8; Result.T.Text := '0'; Result.GRushButton11 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 152).SetSize(41, 17)); - //Result.GRushButton11.Font.FontHeight := 8; + Result.GRushButton11.Font.FontHeight := 8; Result.GRushButton11.All_BorderRoundWidth := 0; Result.GRushButton11.All_BorderRoundHeight := 0; Result.GRushButton11.Down_BorderWidth := 1; Result.GRushButton11.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton12 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 200).SetSize(41, 17)); - //Result.GRushButton12.Font.FontHeight := 8; + Result.GRushButton12.Font.FontHeight := 8; Result.GRushButton12.All_BorderRoundWidth := 0; Result.GRushButton12.All_BorderRoundHeight := 0; Result.GRushButton12.Down_BorderWidth := 1; Result.GRushButton12.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton13 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 248).SetSize(41, 17)); - //Result.GRushButton13.Font.FontHeight := 8; + Result.GRushButton13.Font.FontHeight := 8; Result.GRushButton13.All_BorderRoundWidth := 0; Result.GRushButton13.All_BorderRoundHeight := 0; Result.GRushButton13.Down_BorderWidth := 1; Result.GRushButton13.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton16 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 296).SetSize(41, 17)); - //Result.GRushButton16.Font.FontHeight := 8; + Result.GRushButton16.Font.FontHeight := 8; Result.GRushButton16.All_BorderRoundWidth := 0; Result.GRushButton16.All_BorderRoundHeight := 0; Result.GRushButton16.Down_BorderWidth := 1; Result.GRushButton16.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton17 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 344).SetSize(41, 17)); - //Result.GRushButton17.Font.FontHeight := 8; + Result.GRushButton17.Font.FontHeight := 8; Result.GRushButton17.All_BorderRoundWidth := 0; Result.GRushButton17.All_BorderRoundHeight := 0; Result.GRushButton17.Down_BorderWidth := 1; Result.GRushButton17.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton19 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 368).SetSize(41, 17)); - //Result.GRushButton19.Font.FontHeight := 8; + Result.GRushButton19.Font.FontHeight := 8; Result.GRushButton19.All_BorderRoundWidth := 0; Result.GRushButton19.All_BorderRoundHeight := 0; Result.GRushButton19.Down_BorderWidth := 1; Result.GRushButton19.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton21 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 104).SetSize(41, 17)); - //Result.GRushButton21.Font.FontHeight := 8; + Result.GRushButton21.Font.FontHeight := 8; Result.GRushButton21.All_BorderRoundWidth := 0; Result.GRushButton21.All_BorderRoundHeight := 0; Result.GRushButton21.Down_BorderWidth := 1; Result.GRushButton21.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton22 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 128).SetSize(41, 17)); - //Result.GRushButton22.Font.FontHeight := 8; + Result.GRushButton22.Font.FontHeight := 8; Result.GRushButton22.All_BorderRoundWidth := 0; Result.GRushButton22.All_BorderRoundHeight := 0; Result.GRushButton22.Down_BorderWidth := 1; Result.GRushButton22.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GlyphHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 174).SetSize(57, 0); - //Result.GlyphHorz.Font.FontHeight := 8; + Result.GlyphHorz.Font.FontHeight := 8; Result.GlyphHorz.Color := clWindow; Result.GlyphHorz.Items[0] := 'Left'; Result.GlyphHorz.Items[1] := 'Center'; Result.GlyphHorz.Items[2] := 'Right'; Result.GlyphHorz.CurIndex := 0; Result.GlyphVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 174).SetSize(57, 0); - //Result.GlyphVert.Font.FontHeight := 8; + Result.GlyphVert.Font.FontHeight := 8; Result.GlyphVert.Color := clWindow; Result.GlyphVert.Items[0] := 'Top'; Result.GlyphVert.Items[1] := 'Center'; Result.GlyphVert.Items[2] := 'Bottom'; Result.GlyphVert.CurIndex := 0; Result.TextHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 222).SetSize(57, 0); - //Result.TextHorz.Font.FontHeight := 8; + Result.TextHorz.Font.FontHeight := 8; Result.TextHorz.Color := clWindow; Result.TextHorz.Items[0] := 'Left'; Result.TextHorz.Items[1] := 'Center'; Result.TextHorz.Items[2] := 'Right'; Result.TextHorz.CurIndex := 0; Result.TextVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 222).SetSize(57, 0); - //Result.TextVert.Font.FontHeight := 8; + Result.TextVert.Font.FontHeight := 8; Result.TextVert.Color := clWindow; Result.TextVert.Items[0] := 'Top'; Result.TextVert.Items[1] := 'Center'; Result.TextVert.Items[2] := 'Bottom'; Result.TextVert.CurIndex := 0; Result.UpdateSpeed := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(112, 366).SetSize(81, 21); - //Result.UpdateSpeed.Font.FontHeight := 8; + Result.UpdateSpeed.Font.FontHeight := 8; Result.UpdateSpeed.Color := clWindow; Result.UpdateSpeed.Items[0] := 'Immediately'; Result.UpdateSpeed.Items[1] := 'Very fast'; @@ -635,114 +635,114 @@ begin Result.BorderHe := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 272).SetSize(41, 17); Result.BorderHe.Ctl3D := False; Result.BorderHe.Font.FontStyle := []; - //Result.BorderHe.Font.FontHeight := 8; + Result.BorderHe.Font.FontHeight := 8; Result.BorderWi := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 272).SetSize(41, 17); Result.BorderWi.Ctl3D := False; Result.BorderWi.Font.FontStyle := []; - //Result.BorderWi.Font.FontHeight := 8; + Result.BorderWi.Font.FontHeight := 8; Result.BorderWidth := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 200).SetSize(81, 17); Result.BorderWidth.Ctl3D := False; Result.BorderWidth.Font.FontStyle := []; - //Result.BorderWidth.Font.FontHeight := 8; + Result.BorderWidth.Font.FontHeight := 8; Result.GlyphX := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 320).SetSize(41, 17); Result.GlyphX.Ctl3D := False; Result.GlyphX.Font.FontStyle := []; - //Result.GlyphX.Font.FontHeight := 8; + Result.GlyphX.Font.FontHeight := 8; Result.GlyphY := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 320).SetSize(41, 17); Result.GlyphY.Ctl3D := False; Result.GlyphY.Font.FontStyle := []; - //Result.GlyphY.Font.FontHeight := 8; + Result.GlyphY.Font.FontHeight := 8; Result.ShadowOffset := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 224).SetSize(81, 17); Result.ShadowOffset.Ctl3D := False; Result.ShadowOffset.Font.FontStyle := []; - //Result.ShadowOffset.Font.FontHeight := 8; + Result.ShadowOffset.Font.FontHeight := 8; Result.GRushButton1 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 32).SetSize(41, 17)); Result.GRushButton1.Font.FontStyle := []; - //Result.GRushButton1.Font.FontHeight := 8; + Result.GRushButton1.Font.FontHeight := 8; Result.GRushButton1.All_BorderRoundWidth := 0; Result.GRushButton1.All_BorderRoundHeight := 0; Result.GRushButton1.Down_BorderWidth := 1; Result.GRushButton1.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton10 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 296).SetSize(41, 17)); Result.GRushButton10.Font.FontStyle := []; - //Result.GRushButton10.Font.FontHeight := 8; + Result.GRushButton10.Font.FontHeight := 8; Result.GRushButton10.All_BorderRoundWidth := 0; Result.GRushButton10.All_BorderRoundHeight := 0; Result.GRushButton10.Down_BorderWidth := 1; Result.GRushButton10.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton14 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Reset state').SetPosition(176, 4).SetSize(65, 17)); Result.GRushButton14.Font.FontStyle := []; - //Result.GRushButton14.Font.FontHeight := 8; + Result.GRushButton14.Font.FontHeight := 8; Result.GRushButton14.All_BorderRoundWidth := 0; Result.GRushButton14.All_BorderRoundHeight := 0; Result.GRushButton14.Down_BorderWidth := 1; Result.GRushButton14.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton18 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 176).SetSize(41, 17)); Result.GRushButton18.Font.FontStyle := []; - //Result.GRushButton18.Font.FontHeight := 8; + Result.GRushButton18.Font.FontHeight := 8; Result.GRushButton18.All_BorderRoundWidth := 0; Result.GRushButton18.All_BorderRoundHeight := 0; Result.GRushButton18.Down_BorderWidth := 1; Result.GRushButton18.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton2 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 56).SetSize(41, 17)); Result.GRushButton2.Font.FontStyle := []; - //Result.GRushButton2.Font.FontHeight := 8; + Result.GRushButton2.Font.FontHeight := 8; Result.GRushButton2.All_BorderRoundWidth := 0; Result.GRushButton2.All_BorderRoundHeight := 0; Result.GRushButton2.Down_BorderWidth := 1; Result.GRushButton2.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton3 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 80).SetSize(41, 17)); Result.GRushButton3.Font.FontStyle := []; - //Result.GRushButton3.Font.FontHeight := 8; + Result.GRushButton3.Font.FontHeight := 8; Result.GRushButton3.All_BorderRoundWidth := 0; Result.GRushButton3.All_BorderRoundHeight := 0; Result.GRushButton3.Down_BorderWidth := 1; Result.GRushButton3.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton4 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 104).SetSize(41, 17)); Result.GRushButton4.Font.FontStyle := []; - //Result.GRushButton4.Font.FontHeight := 8; + Result.GRushButton4.Font.FontHeight := 8; Result.GRushButton4.All_BorderRoundWidth := 0; Result.GRushButton4.All_BorderRoundHeight := 0; Result.GRushButton4.Down_BorderWidth := 1; Result.GRushButton4.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton5 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 128).SetSize(41, 17)); Result.GRushButton5.Font.FontStyle := []; - // Result.GRushButton5.Font.FontHeight := 8; + Result.GRushButton5.Font.FontHeight := 8; Result.GRushButton5.All_BorderRoundWidth := 0; Result.GRushButton5.All_BorderRoundHeight := 0; Result.GRushButton5.Down_BorderWidth := 1; Result.GRushButton5.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton6 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 152).SetSize(41, 17)); Result.GRushButton6.Font.FontStyle := []; -// Result.GRushButton6.Font.FontHeight := 8; + Result.GRushButton6.Font.FontHeight := 8; Result.GRushButton6.All_BorderRoundWidth := 0; Result.GRushButton6.All_BorderRoundHeight := 0; Result.GRushButton6.Down_BorderWidth := 1; Result.GRushButton6.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton7 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 200).SetSize(41, 17)); Result.GRushButton7.Font.FontStyle := []; -// Result.GRushButton7.Font.FontHeight := 8; + Result.GRushButton7.Font.FontHeight := 8; Result.GRushButton7.All_BorderRoundWidth := 0; Result.GRushButton7.All_BorderRoundHeight := 0; Result.GRushButton7.Down_BorderWidth := 1; Result.GRushButton7.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton8 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 224).SetSize(41, 17)); Result.GRushButton8.Font.FontStyle := []; -// Result.GRushButton8.Font.FontHeight := 8; + Result.GRushButton8.Font.FontHeight := 8; Result.GRushButton8.All_BorderRoundWidth := 0; Result.GRushButton8.All_BorderRoundHeight := 0; Result.GRushButton8.Down_BorderWidth := 1; Result.GRushButton8.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton9 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 248).SetSize(41, 17)); Result.GRushButton9.Font.FontStyle := []; -// Result.GRushButton9.Font.FontHeight := 8; + Result.GRushButton9.Font.FontHeight := 8; Result.GRushButton9.All_BorderRoundWidth := 0; Result.GRushButton9.All_BorderRoundHeight := 0; Result.GRushButton9.Down_BorderWidth := 1; Result.GRushButton9.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GradStyles := NewComboBox(Result.GRushPanel2, [coReadOnly, coNoIntegralHeight]).SetPosition(112, 174).SetSize(81, 0); Result.GradStyles.Font.FontStyle := []; -// Result.GradStyles.Font.FontHeight := 8; + Result.GradStyles.Font.FontHeight := 8; Result.GradStyles.Color := clWindow; Result.GradStyles.Items[0] := 'Solid'; Result.GradStyles.Items[1] := 'Vertical'; diff --git a/Addons/MCKGRushPanelEditor.pas b/Addons/MCKGRushPanelEditor.pas index 61cff85..c1113e9 100644 --- a/Addons/MCKGRushPanelEditor.pas +++ b/Addons/MCKGRushPanelEditor.pas @@ -261,19 +261,19 @@ begin Result.ButtonOK.Font.FontStyle := [fsBold]; Result.GRushButton15 := PGRushControl(NewGRushButton(Result.Form, 'Reset to souce').SetPosition(400, 408).SetSize(104, 17)); - //Result.GRushButton15.Font.FontHeight := 8; + Result.GRushButton15.Font.FontHeight := 8; Result.GRushButton15.All_BorderRoundWidth := 0; Result.GRushButton15.All_BorderRoundHeight := 0; Result.GRushButton15.Down_BorderWidth := 1; Result.GRushButton15.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton20 := PGRushControl(NewGRushButton(Result.Form, 'Reset to default').SetPosition(272, 408).SetSize(104, 17)); - //Result.GRushButton20.Font.FontHeight := 8; + Result.GRushButton20.Font.FontHeight := 8; Result.GRushButton20.All_BorderRoundWidth := 0; Result.GRushButton20.All_BorderRoundHeight := 0; Result.GRushButton20.Down_BorderWidth := 1; Result.GRushButton20.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.StatesList := NewComboBox(Result.Form, [coReadOnly, coNoIntegralHeight]).SetPosition(328, 10).SetSize(113, 0); - //Result.StatesList.Font.FontHeight := 8; + Result.StatesList.Font.FontHeight := 8; Result.StatesList.Color := clWindow; Result.StatesList.Items[0] := 'All states (w/o)'; Result.StatesList.Items[1] := 'Default state'; @@ -338,85 +338,85 @@ begin Result.Label31.Color := $E8D6CE; Result.B := NewEditBox(Result.GRushPanel1, []).SetPosition(208, 248).SetSize(33, 17); Result.B.Ctl3D := False; - //Result.B.Font.FontHeight := 8; + Result.B.Font.FontHeight := 8; Result.B.Text := '0'; Result.GlyphHeight := NewEditBox(Result.GRushPanel1, []).SetPosition(200, 200).SetSize(41, 17); Result.GlyphHeight.Ctl3D := False; - //Result.GlyphHeight.Font.FontHeight := 8; + Result.GlyphHeight.Font.FontHeight := 8; Result.GlyphHeight.Text := '0'; Result.GlyphWidth := NewEditBox(Result.GRushPanel1, []).SetPosition(80, 200).SetSize(41, 17); Result.GlyphWidth.Ctl3D := False; - //Result.GlyphWidth.Font.FontHeight := 8; + Result.GlyphWidth.Font.FontHeight := 8; Result.GlyphWidth.Text := '0'; Result.L := NewEditBox(Result.GRushPanel1, []).SetPosition(28, 248).SetSize(33, 17); Result.L.Ctl3D := False; - //Result.L.Font.FontHeight := 8; + Result.L.Font.FontHeight := 8; Result.L.Text := '0'; Result.R := NewEditBox(Result.GRushPanel1, []).SetPosition(148, 248).SetSize(33, 17); Result.R.Ctl3D := False; - //Result.R.Font.FontHeight := 8; + Result.R.Font.FontHeight := 8; Result.R.Text := '0'; Result.Spacing := NewEditBox(Result.GRushPanel1, []).SetPosition(112, 272).SetSize(81, 17); Result.Spacing.Ctl3D := False; - //Result.Spacing.Font.FontHeight := 8; + Result.Spacing.Font.FontHeight := 8; Result.Spacing.Text := '0'; Result.T := NewEditBox(Result.GRushPanel1, []).SetPosition(88, 248).SetSize(33, 17); Result.T.Ctl3D := False; - //Result.T.Font.FontHeight := 8; + Result.T.Font.FontHeight := 8; Result.T.Text := '0'; Result.GRushButton11 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 80).SetSize(41, 17)); - //Result.GRushButton11.Font.FontHeight := 8; + Result.GRushButton11.Font.FontHeight := 8; Result.GRushButton11.All_BorderRoundWidth := 0; Result.GRushButton11.All_BorderRoundHeight := 0; Result.GRushButton11.Down_BorderWidth := 1; Result.GRushButton11.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton12 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 128).SetSize(41, 17)); - //Result.GRushButton12.Font.FontHeight := 8; + Result.GRushButton12.Font.FontHeight := 8; Result.GRushButton12.All_BorderRoundWidth := 0; Result.GRushButton12.All_BorderRoundHeight := 0; Result.GRushButton12.Down_BorderWidth := 1; Result.GRushButton12.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton13 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 176).SetSize(41, 17)); - //Result.GRushButton13.Font.FontHeight := 8; + Result.GRushButton13.Font.FontHeight := 8; Result.GRushButton13.All_BorderRoundWidth := 0; Result.GRushButton13.All_BorderRoundHeight := 0; Result.GRushButton13.Down_BorderWidth := 1; Result.GRushButton13.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton16 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 224).SetSize(41, 17)); - //Result.GRushButton16.Font.FontHeight := 8; + Result.GRushButton16.Font.FontHeight := 8; Result.GRushButton16.All_BorderRoundWidth := 0; Result.GRushButton16.All_BorderRoundHeight := 0; Result.GRushButton16.Down_BorderWidth := 1; Result.GRushButton16.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton17 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 272).SetSize(41, 17)); - //Result.GRushButton17.Font.FontHeight := 8; + Result.GRushButton17.Font.FontHeight := 8; Result.GRushButton17.All_BorderRoundWidth := 0; Result.GRushButton17.All_BorderRoundHeight := 0; Result.GRushButton17.Down_BorderWidth := 1; Result.GRushButton17.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GlyphHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 102).SetSize(57, 0); - //Result.GlyphHorz.Font.FontHeight := 8; + Result.GlyphHorz.Font.FontHeight := 8; Result.GlyphHorz.Color := clWindow; Result.GlyphHorz.Items[0] := 'Left'; Result.GlyphHorz.Items[1] := 'Center'; Result.GlyphHorz.Items[2] := 'Right'; Result.GlyphHorz.CurIndex := 0; Result.GlyphVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 102).SetSize(57, 0); - //Result.GlyphVert.Font.FontHeight := 8; + Result.GlyphVert.Font.FontHeight := 8; Result.GlyphVert.Color := clWindow; Result.GlyphVert.Items[0] := 'Top'; Result.GlyphVert.Items[1] := 'Center'; Result.GlyphVert.Items[2] := 'Bottom'; Result.GlyphVert.CurIndex := 0; Result.TextHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 150).SetSize(57, 0); - //Result.TextHorz.Font.FontHeight := 8; + Result.TextHorz.Font.FontHeight := 8; Result.TextHorz.Color := clWindow; Result.TextHorz.Items[0] := 'Left'; Result.TextHorz.Items[1] := 'Center'; Result.TextHorz.Items[2] := 'Right'; Result.TextHorz.CurIndex := 0; Result.TextVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 150).SetSize(57, 0); - //Result.TextVert.Font.FontHeight := 8; + Result.TextVert.Font.FontHeight := 8; Result.TextVert.Color := clWindow; Result.TextVert.Items[0] := 'Top'; Result.TextVert.Items[1] := 'Center'; @@ -576,114 +576,114 @@ begin Result.BorderHe := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 272).SetSize(41, 17); Result.BorderHe.Ctl3D := False; Result.BorderHe.Font.FontStyle := []; - //Result.BorderHe.Font.FontHeight := 8; + Result.BorderHe.Font.FontHeight := 8; Result.BorderWi := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 272).SetSize(41, 17); Result.BorderWi.Ctl3D := False; Result.BorderWi.Font.FontStyle := []; - //Result.BorderWi.Font.FontHeight := 8; + Result.BorderWi.Font.FontHeight := 8; Result.BorderWidth := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 200).SetSize(81, 17); Result.BorderWidth.Ctl3D := False; Result.BorderWidth.Font.FontStyle := []; - //Result.BorderWidth.Font.FontHeight := 8; + Result.BorderWidth.Font.FontHeight := 8; Result.GlyphX := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 320).SetSize(41, 17); Result.GlyphX.Ctl3D := False; Result.GlyphX.Font.FontStyle := []; - //Result.GlyphX.Font.FontHeight := 8; + Result.GlyphX.Font.FontHeight := 8; Result.GlyphY := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 320).SetSize(41, 17); Result.GlyphY.Ctl3D := False; Result.GlyphY.Font.FontStyle := []; - //Result.GlyphY.Font.FontHeight := 8; + Result.GlyphY.Font.FontHeight := 8; Result.ShadowOffset := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 224).SetSize(81, 17); Result.ShadowOffset.Ctl3D := False; Result.ShadowOffset.Font.FontStyle := []; - //Result.ShadowOffset.Font.FontHeight := 8; + Result.ShadowOffset.Font.FontHeight := 8; Result.GRushButton1 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 32).SetSize(41, 17)); Result.GRushButton1.Font.FontStyle := []; - //Result.GRushButton1.Font.FontHeight := 8; + Result.GRushButton1.Font.FontHeight := 8; Result.GRushButton1.All_BorderRoundWidth := 0; Result.GRushButton1.All_BorderRoundHeight := 0; Result.GRushButton1.Down_BorderWidth := 1; Result.GRushButton1.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton10 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 296).SetSize(41, 17)); Result.GRushButton10.Font.FontStyle := []; - //Result.GRushButton10.Font.FontHeight := 8; + Result.GRushButton10.Font.FontHeight := 8; Result.GRushButton10.All_BorderRoundWidth := 0; Result.GRushButton10.All_BorderRoundHeight := 0; Result.GRushButton10.Down_BorderWidth := 1; Result.GRushButton10.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton14 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Reset state').SetPosition(176, 4).SetSize(65, 17)); Result.GRushButton14.Font.FontStyle := []; - //Result.GRushButton14.Font.FontHeight := 8; + Result.GRushButton14.Font.FontHeight := 8; Result.GRushButton14.All_BorderRoundWidth := 0; Result.GRushButton14.All_BorderRoundHeight := 0; Result.GRushButton14.Down_BorderWidth := 1; Result.GRushButton14.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton18 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 176).SetSize(41, 17)); Result.GRushButton18.Font.FontStyle := []; - //Result.GRushButton18.Font.FontHeight := 8; + Result.GRushButton18.Font.FontHeight := 8; Result.GRushButton18.All_BorderRoundWidth := 0; Result.GRushButton18.All_BorderRoundHeight := 0; Result.GRushButton18.Down_BorderWidth := 1; Result.GRushButton18.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton2 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 56).SetSize(41, 17)); Result.GRushButton2.Font.FontStyle := []; - //Result.GRushButton2.Font.FontHeight := 8; + Result.GRushButton2.Font.FontHeight := 8; Result.GRushButton2.All_BorderRoundWidth := 0; Result.GRushButton2.All_BorderRoundHeight := 0; Result.GRushButton2.Down_BorderWidth := 1; Result.GRushButton2.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton3 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 80).SetSize(41, 17)); Result.GRushButton3.Font.FontStyle := []; - //Result.GRushButton3.Font.FontHeight := 8; + Result.GRushButton3.Font.FontHeight := 8; Result.GRushButton3.All_BorderRoundWidth := 0; Result.GRushButton3.All_BorderRoundHeight := 0; Result.GRushButton3.Down_BorderWidth := 1; Result.GRushButton3.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton4 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 104).SetSize(41, 17)); Result.GRushButton4.Font.FontStyle := []; - //Result.GRushButton4.Font.FontHeight := 8; + Result.GRushButton4.Font.FontHeight := 8; Result.GRushButton4.All_BorderRoundWidth := 0; Result.GRushButton4.All_BorderRoundHeight := 0; Result.GRushButton4.Down_BorderWidth := 1; Result.GRushButton4.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton5 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 128).SetSize(41, 17)); Result.GRushButton5.Font.FontStyle := []; - //Result.GRushButton5.Font.FontHeight := 8; + Result.GRushButton5.Font.FontHeight := 8; Result.GRushButton5.All_BorderRoundWidth := 0; Result.GRushButton5.All_BorderRoundHeight := 0; Result.GRushButton5.Down_BorderWidth := 1; Result.GRushButton5.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton6 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 152).SetSize(41, 17)); Result.GRushButton6.Font.FontStyle := []; - //Result.GRushButton6.Font.FontHeight := 8; + Result.GRushButton6.Font.FontHeight := 8; Result.GRushButton6.All_BorderRoundWidth := 0; Result.GRushButton6.All_BorderRoundHeight := 0; Result.GRushButton6.Down_BorderWidth := 1; Result.GRushButton6.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton7 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 200).SetSize(41, 17)); Result.GRushButton7.Font.FontStyle := []; - //Result.GRushButton7.Font.FontHeight := 8; + Result.GRushButton7.Font.FontHeight := 8; Result.GRushButton7.All_BorderRoundWidth := 0; Result.GRushButton7.All_BorderRoundHeight := 0; Result.GRushButton7.Down_BorderWidth := 1; Result.GRushButton7.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton8 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 224).SetSize(41, 17)); Result.GRushButton8.Font.FontStyle := []; - //Result.GRushButton8.Font.FontHeight := 8; + Result.GRushButton8.Font.FontHeight := 8; Result.GRushButton8.All_BorderRoundWidth := 0; Result.GRushButton8.All_BorderRoundHeight := 0; Result.GRushButton8.Down_BorderWidth := 1; Result.GRushButton8.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton9 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 248).SetSize(41, 17)); Result.GRushButton9.Font.FontStyle := []; - //Result.GRushButton9.Font.FontHeight := 8; + Result.GRushButton9.Font.FontHeight := 8; Result.GRushButton9.All_BorderRoundWidth := 0; Result.GRushButton9.All_BorderRoundHeight := 0; Result.GRushButton9.Down_BorderWidth := 1; Result.GRushButton9.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GradStyles := NewComboBox(Result.GRushPanel2, [coReadOnly, coNoIntegralHeight]).SetPosition(112, 174).SetSize(81, 0); Result.GradStyles.Font.FontStyle := []; - //Result.GradStyles.Font.FontHeight := 8; + Result.GradStyles.Font.FontHeight := 8; Result.GradStyles.Color := clWindow; Result.GradStyles.Items[0] := 'Solid'; Result.GradStyles.Items[1] := 'Vertical'; diff --git a/Addons/MCKGRushProgressBarEditor.pas b/Addons/MCKGRushProgressBarEditor.pas index 21238c5..10d184d 100644 --- a/Addons/MCKGRushProgressBarEditor.pas +++ b/Addons/MCKGRushProgressBarEditor.pas @@ -272,19 +272,19 @@ begin Result.ButtonOK := PGRushControl(NewGRushButton(Result.Form, 'OK').SetPosition(272, 512).SetSize(105, 33)); Result.ButtonOK.Font.FontStyle := [fsBold]; Result.GRushButton15 := PGRushControl(NewGRushButton(Result.Form, 'Reset to souce').SetPosition(400, 408).SetSize(104, 17)); - //Result.GRushButton15.Font.FontHeight := 8; + Result.GRushButton15.Font.FontHeight := 8; Result.GRushButton15.All_BorderRoundWidth := 0; Result.GRushButton15.All_BorderRoundHeight := 0; Result.GRushButton15.Down_BorderWidth := 1; Result.GRushButton15.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton20 := PGRushControl(NewGRushButton(Result.Form, 'Reset to default').SetPosition(272, 408).SetSize(104, 17)); - //Result.GRushButton20.Font.FontHeight := 8; + Result.GRushButton20.Font.FontHeight := 8; Result.GRushButton20.All_BorderRoundWidth := 0; Result.GRushButton20.All_BorderRoundHeight := 0; Result.GRushButton20.Down_BorderWidth := 1; Result.GRushButton20.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.StatesList := NewComboBox(Result.Form, [coReadOnly, coNoIntegralHeight]).SetPosition(328, 10).SetSize(113, 0); - //Result.StatesList.Font.FontHeight := 8; + Result.StatesList.Font.FontHeight := 8; Result.StatesList.Color := clWindow; Result.StatesList.Items[0] := 'All states (w/o)'; Result.StatesList.Items[1] := 'Default state'; @@ -349,85 +349,85 @@ begin Result.Label31.Color := $E8D6CE; Result.B := NewEditBox(Result.GRushPanel1, []).SetPosition(208, 296).SetSize(33, 17); Result.B.Ctl3D := False; - //Result.B.Font.FontHeight := 8; + Result.B.Font.FontHeight := 8; Result.B.Text := '0'; Result.GlyphHeight := NewEditBox(Result.GRushPanel1, []).SetPosition(200, 248).SetSize(41, 17); Result.GlyphHeight.Ctl3D := False; - //Result.GlyphHeight.Font.FontHeight := 8; + Result.GlyphHeight.Font.FontHeight := 8; Result.GlyphHeight.Text := '0'; Result.GlyphWidth := NewEditBox(Result.GRushPanel1, []).SetPosition(80, 248).SetSize(41, 17); Result.GlyphWidth.Ctl3D := False; - //Result.GlyphWidth.Font.FontHeight := 8; + Result.GlyphWidth.Font.FontHeight := 8; Result.GlyphWidth.Text := '0'; Result.L := NewEditBox(Result.GRushPanel1, []).SetPosition(28, 296).SetSize(33, 17); Result.L.Ctl3D := False; - //Result.L.Font.FontHeight := 8; + Result.L.Font.FontHeight := 8; Result.L.Text := '0'; Result.R := NewEditBox(Result.GRushPanel1, []).SetPosition(148, 296).SetSize(33, 17); Result.R.Ctl3D := False; - //Result.R.Font.FontHeight := 8; + Result.R.Font.FontHeight := 8; Result.R.Text := '0'; Result.Spacing := NewEditBox(Result.GRushPanel1, []).SetPosition(112, 320).SetSize(81, 17); Result.Spacing.Ctl3D := False; - //Result.Spacing.Font.FontHeight := 8; + Result.Spacing.Font.FontHeight := 8; Result.Spacing.Text := '0'; Result.T := NewEditBox(Result.GRushPanel1, []).SetPosition(88, 296).SetSize(33, 17); Result.T.Ctl3D := False; - //Result.T.Font.FontHeight := 8; + Result.T.Font.FontHeight := 8; Result.T.Text := '0'; Result.GRushButton11 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 128).SetSize(41, 17)); - //Result.GRushButton11.Font.FontHeight := 8; + Result.GRushButton11.Font.FontHeight := 8; Result.GRushButton11.All_BorderRoundWidth := 0; Result.GRushButton11.All_BorderRoundHeight := 0; Result.GRushButton11.Down_BorderWidth := 1; Result.GRushButton11.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton12 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 176).SetSize(41, 17)); - //Result.GRushButton12.Font.FontHeight := 8; + Result.GRushButton12.Font.FontHeight := 8; Result.GRushButton12.All_BorderRoundWidth := 0; Result.GRushButton12.All_BorderRoundHeight := 0; Result.GRushButton12.Down_BorderWidth := 1; Result.GRushButton12.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton13 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 224).SetSize(41, 17)); - //Result.GRushButton13.Font.FontHeight := 8; + Result.GRushButton13.Font.FontHeight := 8; Result.GRushButton13.All_BorderRoundWidth := 0; Result.GRushButton13.All_BorderRoundHeight := 0; Result.GRushButton13.Down_BorderWidth := 1; Result.GRushButton13.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton16 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 272).SetSize(41, 17)); - //Result.GRushButton16.Font.FontHeight := 8; + Result.GRushButton16.Font.FontHeight := 8; Result.GRushButton16.All_BorderRoundWidth := 0; Result.GRushButton16.All_BorderRoundHeight := 0; Result.GRushButton16.Down_BorderWidth := 1; Result.GRushButton16.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton17 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 320).SetSize(41, 17)); - //Result.GRushButton17.Font.FontHeight := 8; + Result.GRushButton17.Font.FontHeight := 8; Result.GRushButton17.All_BorderRoundWidth := 0; Result.GRushButton17.All_BorderRoundHeight := 0; Result.GRushButton17.Down_BorderWidth := 1; Result.GRushButton17.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GlyphHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 150).SetSize(57, 0); - //Result.GlyphHorz.Font.FontHeight := 8; + Result.GlyphHorz.Font.FontHeight := 8; Result.GlyphHorz.Color := clWindow; Result.GlyphHorz.Items[0] := 'Left'; Result.GlyphHorz.Items[1] := 'Center'; Result.GlyphHorz.Items[2] := 'Right'; Result.GlyphHorz.CurIndex := 0; Result.GlyphVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 150).SetSize(57, 0); - //Result.GlyphVert.Font.FontHeight := 8; + Result.GlyphVert.Font.FontHeight := 8; Result.GlyphVert.Color := clWindow; Result.GlyphVert.Items[0] := 'Top'; Result.GlyphVert.Items[1] := 'Center'; Result.GlyphVert.Items[2] := 'Bottom'; Result.GlyphVert.CurIndex := 0; Result.TextHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 198).SetSize(57, 0); - //Result.TextHorz.Font.FontHeight := 8; + Result.TextHorz.Font.FontHeight := 8; Result.TextHorz.Color := clWindow; Result.TextHorz.Items[0] := 'Left'; Result.TextHorz.Items[1] := 'Center'; Result.TextHorz.Items[2] := 'Right'; Result.TextHorz.CurIndex := 0; Result.TextVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 198).SetSize(57, 0); - //Result.TextVert.Font.FontHeight := 8; + Result.TextVert.Font.FontHeight := 8; Result.TextVert.Color := clWindow; Result.TextVert.Items[0] := 'Top'; Result.TextVert.Items[1] := 'Center'; @@ -623,114 +623,114 @@ begin Result.BorderHe := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 272).SetSize(41, 17); Result.BorderHe.Ctl3D := False; Result.BorderHe.Font.FontStyle := []; - //Result.BorderHe.Font.FontHeight := 8; + Result.BorderHe.Font.FontHeight := 8; Result.BorderWi := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 272).SetSize(41, 17); Result.BorderWi.Ctl3D := False; Result.BorderWi.Font.FontStyle := []; - //Result.BorderWi.Font.FontHeight := 8; + Result.BorderWi.Font.FontHeight := 8; Result.BorderWidth := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 200).SetSize(81, 17); Result.BorderWidth.Ctl3D := False; Result.BorderWidth.Font.FontStyle := []; - //Result.BorderWidth.Font.FontHeight := 8; + Result.BorderWidth.Font.FontHeight := 8; Result.GlyphX := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 320).SetSize(41, 17); Result.GlyphX.Ctl3D := False; Result.GlyphX.Font.FontStyle := []; - //Result.GlyphX.Font.FontHeight := 8; + Result.GlyphX.Font.FontHeight := 8; Result.GlyphY := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 320).SetSize(41, 17); Result.GlyphY.Ctl3D := False; Result.GlyphY.Font.FontStyle := []; - //Result.GlyphY.Font.FontHeight := 8; + Result.GlyphY.Font.FontHeight := 8; Result.ShadowOffset := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 224).SetSize(81, 17); Result.ShadowOffset.Ctl3D := False; Result.ShadowOffset.Font.FontStyle := []; - //Result.ShadowOffset.Font.FontHeight := 8; + Result.ShadowOffset.Font.FontHeight := 8; Result.GRushButton1 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 32).SetSize(41, 17)); Result.GRushButton1.Font.FontStyle := []; - //Result.GRushButton1.Font.FontHeight := 8; + Result.GRushButton1.Font.FontHeight := 8; Result.GRushButton1.All_BorderRoundWidth := 0; Result.GRushButton1.All_BorderRoundHeight := 0; Result.GRushButton1.Down_BorderWidth := 1; Result.GRushButton1.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton10 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 296).SetSize(41, 17)); Result.GRushButton10.Font.FontStyle := []; - //Result.GRushButton10.Font.FontHeight := 8; + Result.GRushButton10.Font.FontHeight := 8; Result.GRushButton10.All_BorderRoundWidth := 0; Result.GRushButton10.All_BorderRoundHeight := 0; Result.GRushButton10.Down_BorderWidth := 1; Result.GRushButton10.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton14 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Reset state').SetPosition(176, 4).SetSize(65, 17)); Result.GRushButton14.Font.FontStyle := []; - //Result.GRushButton14.Font.FontHeight := 8; + Result.GRushButton14.Font.FontHeight := 8; Result.GRushButton14.All_BorderRoundWidth := 0; Result.GRushButton14.All_BorderRoundHeight := 0; Result.GRushButton14.Down_BorderWidth := 1; Result.GRushButton14.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton18 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 176).SetSize(41, 17)); Result.GRushButton18.Font.FontStyle := []; - //Result.GRushButton18.Font.FontHeight := 8; + Result.GRushButton18.Font.FontHeight := 8; Result.GRushButton18.All_BorderRoundWidth := 0; Result.GRushButton18.All_BorderRoundHeight := 0; Result.GRushButton18.Down_BorderWidth := 1; Result.GRushButton18.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton2 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 56).SetSize(41, 17)); Result.GRushButton2.Font.FontStyle := []; - //Result.GRushButton2.Font.FontHeight := 8; + Result.GRushButton2.Font.FontHeight := 8; Result.GRushButton2.All_BorderRoundWidth := 0; Result.GRushButton2.All_BorderRoundHeight := 0; Result.GRushButton2.Down_BorderWidth := 1; Result.GRushButton2.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton3 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 80).SetSize(41, 17)); Result.GRushButton3.Font.FontStyle := []; - //Result.GRushButton3.Font.FontHeight := 8; + Result.GRushButton3.Font.FontHeight := 8; Result.GRushButton3.All_BorderRoundWidth := 0; Result.GRushButton3.All_BorderRoundHeight := 0; Result.GRushButton3.Down_BorderWidth := 1; Result.GRushButton3.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton4 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 104).SetSize(41, 17)); Result.GRushButton4.Font.FontStyle := []; - //Result.GRushButton4.Font.FontHeight := 8; + Result.GRushButton4.Font.FontHeight := 8; Result.GRushButton4.All_BorderRoundWidth := 0; Result.GRushButton4.All_BorderRoundHeight := 0; Result.GRushButton4.Down_BorderWidth := 1; Result.GRushButton4.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton5 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 128).SetSize(41, 17)); Result.GRushButton5.Font.FontStyle := []; - //Result.GRushButton5.Font.FontHeight := 8; + Result.GRushButton5.Font.FontHeight := 8; Result.GRushButton5.All_BorderRoundWidth := 0; Result.GRushButton5.All_BorderRoundHeight := 0; Result.GRushButton5.Down_BorderWidth := 1; Result.GRushButton5.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton6 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 152).SetSize(41, 17)); Result.GRushButton6.Font.FontStyle := []; - //Result.GRushButton6.Font.FontHeight := 8; + Result.GRushButton6.Font.FontHeight := 8; Result.GRushButton6.All_BorderRoundWidth := 0; Result.GRushButton6.All_BorderRoundHeight := 0; Result.GRushButton6.Down_BorderWidth := 1; Result.GRushButton6.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton7 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 200).SetSize(41, 17)); Result.GRushButton7.Font.FontStyle := []; - //Result.GRushButton7.Font.FontHeight := 8; + Result.GRushButton7.Font.FontHeight := 8; Result.GRushButton7.All_BorderRoundWidth := 0; Result.GRushButton7.All_BorderRoundHeight := 0; Result.GRushButton7.Down_BorderWidth := 1; Result.GRushButton7.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton8 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 224).SetSize(41, 17)); Result.GRushButton8.Font.FontStyle := []; - //Result.GRushButton8.Font.FontHeight := 8; + Result.GRushButton8.Font.FontHeight := 8; Result.GRushButton8.All_BorderRoundWidth := 0; Result.GRushButton8.All_BorderRoundHeight := 0; Result.GRushButton8.Down_BorderWidth := 1; Result.GRushButton8.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton9 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 248).SetSize(41, 17)); Result.GRushButton9.Font.FontStyle := []; - //Result.GRushButton9.Font.FontHeight := 8; + Result.GRushButton9.Font.FontHeight := 8; Result.GRushButton9.All_BorderRoundWidth := 0; Result.GRushButton9.All_BorderRoundHeight := 0; Result.GRushButton9.Down_BorderWidth := 1; Result.GRushButton9.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GradStyles := NewComboBox(Result.GRushPanel2, [coReadOnly, coNoIntegralHeight]).SetPosition(112, 174).SetSize(81, 0); Result.GradStyles.Font.FontStyle := []; - //Result.GradStyles.Font.FontHeight := 8; + Result.GradStyles.Font.FontHeight := 8; Result.GradStyles.Color := clWindow; Result.GradStyles.Items[0] := 'Solid'; Result.GradStyles.Items[1] := 'Vertical'; diff --git a/Addons/MCKGRushRadioBoxEditor.pas b/Addons/MCKGRushRadioBoxEditor.pas index 4adaf1f..f644f1f 100644 --- a/Addons/MCKGRushRadioBoxEditor.pas +++ b/Addons/MCKGRushRadioBoxEditor.pas @@ -278,19 +278,19 @@ begin Result.ButtonOK := PGRushControl(NewGRushButton(Result.Form, 'OK').SetPosition(272, 504).SetSize(105, 33)); Result.ButtonOK.Font.FontStyle := [fsBold]; Result.GRushButton15 := PGRushControl(NewGRushButton(Result.Form, 'Reset to souce').SetPosition(401, 408).SetSize(104, 17)); - //Result.GRushButton15.Font.FontHeight := 8; + Result.GRushButton15.Font.FontHeight := 8; Result.GRushButton15.All_BorderRoundWidth := 0; Result.GRushButton15.All_BorderRoundHeight := 0; Result.GRushButton15.Down_BorderWidth := 1; Result.GRushButton15.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton20 := PGRushControl(NewGRushButton(Result.Form, 'Reset to default').SetPosition(273, 408).SetSize(104, 17)); - //Result.GRushButton20.Font.FontHeight := 8; + Result.GRushButton20.Font.FontHeight := 8; Result.GRushButton20.All_BorderRoundWidth := 0; Result.GRushButton20.All_BorderRoundHeight := 0; Result.GRushButton20.Down_BorderWidth := 1; Result.GRushButton20.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.StatesList := NewComboBox(Result.Form, [coReadOnly, coNoIntegralHeight]).SetPosition(328, 10).SetSize(113, 0); - //Result.StatesList.Font.FontHeight := 8; + Result.StatesList.Font.FontHeight := 8; Result.StatesList.Color := clWindow; Result.StatesList.Items[0] := 'All states (w/o)'; Result.StatesList.Items[1] := 'Default state'; @@ -368,113 +368,113 @@ begin Result.Label33.Color := $E8D6CE; Result.B := NewEditBox(Result.GRushPanel1, []).SetPosition(208, 320).SetSize(33, 17); Result.B.Ctl3D := False; - //Result.B.Font.FontHeight := 8; + Result.B.Font.FontHeight := 8; Result.B.Text := '0'; Result.CheckMetric := NewEditBox(Result.GRushPanel1, []).SetPosition(112, 128).SetSize(81, 17); Result.CheckMetric.Ctl3D := False; - //Result.CheckMetric.Font.FontHeight := 8; + Result.CheckMetric.Font.FontHeight := 8; Result.GlyphHeight := NewEditBox(Result.GRushPanel1, []).SetPosition(200, 272).SetSize(41, 17); Result.GlyphHeight.Ctl3D := False; - //Result.GlyphHeight.Font.FontHeight := 8; + Result.GlyphHeight.Font.FontHeight := 8; Result.GlyphHeight.Text := '0'; Result.GlyphWidth := NewEditBox(Result.GRushPanel1, []).SetPosition(80, 272).SetSize(41, 17); Result.GlyphWidth.Ctl3D := False; - //Result.GlyphWidth.Font.FontHeight := 8; + Result.GlyphWidth.Font.FontHeight := 8; Result.GlyphWidth.Text := '0'; Result.L := NewEditBox(Result.GRushPanel1, []).SetPosition(28, 320).SetSize(33, 17); Result.L.Ctl3D := False; - //Result.L.Font.FontHeight := 8; + Result.L.Font.FontHeight := 8; Result.L.Text := '0'; Result.R := NewEditBox(Result.GRushPanel1, []).SetPosition(148, 320).SetSize(33, 17); Result.R.Ctl3D := False; - //Result.R.Font.FontHeight := 8; + Result.R.Font.FontHeight := 8; Result.R.Text := '0'; Result.Spacing := NewEditBox(Result.GRushPanel1, []).SetPosition(112, 344).SetSize(81, 17); Result.Spacing.Ctl3D := False; - //Result.Spacing.Font.FontHeight := 8; + Result.Spacing.Font.FontHeight := 8; Result.Spacing.Text := '0'; Result.T := NewEditBox(Result.GRushPanel1, []).SetPosition(88, 320).SetSize(33, 17); Result.T.Ctl3D := False; - //Result.T.Font.FontHeight := 8; + Result.T.Font.FontHeight := 8; Result.T.Text := '0'; Result.GRushButton11 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 152).SetSize(41, 17)); - //Result.GRushButton11.Font.FontHeight := 8; + Result.GRushButton11.Font.FontHeight := 8; Result.GRushButton11.All_BorderRoundWidth := 0; Result.GRushButton11.All_BorderRoundHeight := 0; Result.GRushButton11.Down_BorderWidth := 1; Result.GRushButton11.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton12 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 200).SetSize(41, 17)); - //Result.GRushButton12.Font.FontHeight := 8; + Result.GRushButton12.Font.FontHeight := 8; Result.GRushButton12.All_BorderRoundWidth := 0; Result.GRushButton12.All_BorderRoundHeight := 0; Result.GRushButton12.Down_BorderWidth := 1; Result.GRushButton12.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton13 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 248).SetSize(41, 17)); - //Result.GRushButton13.Font.FontHeight := 8; + Result.GRushButton13.Font.FontHeight := 8; Result.GRushButton13.All_BorderRoundWidth := 0; Result.GRushButton13.All_BorderRoundHeight := 0; Result.GRushButton13.Down_BorderWidth := 1; Result.GRushButton13.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton16 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 296).SetSize(41, 17)); - //Result.GRushButton16.Font.FontHeight := 8; + Result.GRushButton16.Font.FontHeight := 8; Result.GRushButton16.All_BorderRoundWidth := 0; Result.GRushButton16.All_BorderRoundHeight := 0; Result.GRushButton16.Down_BorderWidth := 1; Result.GRushButton16.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton17 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 344).SetSize(41, 17)); - //Result.GRushButton17.Font.FontHeight := 8; + Result.GRushButton17.Font.FontHeight := 8; Result.GRushButton17.All_BorderRoundWidth := 0; Result.GRushButton17.All_BorderRoundHeight := 0; Result.GRushButton17.Down_BorderWidth := 1; Result.GRushButton17.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton19 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 368).SetSize(41, 17)); - //Result.GRushButton19.Font.FontHeight := 8; + Result.GRushButton19.Font.FontHeight := 8; Result.GRushButton19.All_BorderRoundWidth := 0; Result.GRushButton19.All_BorderRoundHeight := 0; Result.GRushButton19.Down_BorderWidth := 1; Result.GRushButton19.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton21 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 104).SetSize(41, 17)); - //Result.GRushButton21.Font.FontHeight := 8; + Result.GRushButton21.Font.FontHeight := 8; Result.GRushButton21.All_BorderRoundWidth := 0; Result.GRushButton21.All_BorderRoundHeight := 0; Result.GRushButton21.Down_BorderWidth := 1; Result.GRushButton21.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton22 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 128).SetSize(41, 17)); - //Result.GRushButton22.Font.FontHeight := 8; + Result.GRushButton22.Font.FontHeight := 8; Result.GRushButton22.All_BorderRoundWidth := 0; Result.GRushButton22.All_BorderRoundHeight := 0; Result.GRushButton22.Down_BorderWidth := 1; Result.GRushButton22.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GlyphHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 174).SetSize(57, 0); - //Result.GlyphHorz.Font.FontHeight := 8; + Result.GlyphHorz.Font.FontHeight := 8; Result.GlyphHorz.Color := clWindow; Result.GlyphHorz.Items[0] := 'Left'; Result.GlyphHorz.Items[1] := 'Center'; Result.GlyphHorz.Items[2] := 'Right'; Result.GlyphHorz.CurIndex := 0; Result.GlyphVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 174).SetSize(57, 0); - //Result.GlyphVert.Font.FontHeight := 8; + Result.GlyphVert.Font.FontHeight := 8; Result.GlyphVert.Color := clWindow; Result.GlyphVert.Items[0] := 'Top'; Result.GlyphVert.Items[1] := 'Center'; Result.GlyphVert.Items[2] := 'Bottom'; Result.GlyphVert.CurIndex := 0; Result.TextHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 222).SetSize(57, 0); - //Result.TextHorz.Font.FontHeight := 8; + Result.TextHorz.Font.FontHeight := 8; Result.TextHorz.Color := clWindow; Result.TextHorz.Items[0] := 'Left'; Result.TextHorz.Items[1] := 'Center'; Result.TextHorz.Items[2] := 'Right'; Result.TextHorz.CurIndex := 0; Result.TextVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 222).SetSize(57, 0); - //Result.TextVert.Font.FontHeight := 8; + Result.TextVert.Font.FontHeight := 8; Result.TextVert.Color := clWindow; Result.TextVert.Items[0] := 'Top'; Result.TextVert.Items[1] := 'Center'; Result.TextVert.Items[2] := 'Bottom'; Result.TextVert.CurIndex := 0; Result.UpdateSpeed := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(112, 366).SetSize(81, 21); - //Result.UpdateSpeed.Font.FontHeight := 8; + Result.UpdateSpeed.Font.FontHeight := 8; Result.UpdateSpeed.Color := clWindow; Result.UpdateSpeed.Items[0] := 'Immediately'; Result.UpdateSpeed.Items[1] := 'Very fast'; @@ -635,114 +635,114 @@ begin Result.BorderHe := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 272).SetSize(41, 17); Result.BorderHe.Ctl3D := False; Result.BorderHe.Font.FontStyle := []; - //Result.BorderHe.Font.FontHeight := 8; + Result.BorderHe.Font.FontHeight := 8; Result.BorderWi := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 272).SetSize(41, 17); Result.BorderWi.Ctl3D := False; Result.BorderWi.Font.FontStyle := []; - //Result.BorderWi.Font.FontHeight := 8; + Result.BorderWi.Font.FontHeight := 8; Result.BorderWidth := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 200).SetSize(81, 17); Result.BorderWidth.Ctl3D := False; Result.BorderWidth.Font.FontStyle := []; - //Result.BorderWidth.Font.FontHeight := 8; + Result.BorderWidth.Font.FontHeight := 8; Result.GlyphX := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 320).SetSize(41, 17); Result.GlyphX.Ctl3D := False; Result.GlyphX.Font.FontStyle := []; - //Result.GlyphX.Font.FontHeight := 8; + Result.GlyphX.Font.FontHeight := 8; Result.GlyphY := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 320).SetSize(41, 17); Result.GlyphY.Ctl3D := False; Result.GlyphY.Font.FontStyle := []; - //Result.GlyphY.Font.FontHeight := 8; + Result.GlyphY.Font.FontHeight := 8; Result.ShadowOffset := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 224).SetSize(81, 17); Result.ShadowOffset.Ctl3D := False; Result.ShadowOffset.Font.FontStyle := []; - //Result.ShadowOffset.Font.FontHeight := 8; + Result.ShadowOffset.Font.FontHeight := 8; Result.GRushButton1 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 32).SetSize(41, 17)); Result.GRushButton1.Font.FontStyle := []; - //Result.GRushButton1.Font.FontHeight := 8; + Result.GRushButton1.Font.FontHeight := 8; Result.GRushButton1.All_BorderRoundWidth := 0; Result.GRushButton1.All_BorderRoundHeight := 0; Result.GRushButton1.Down_BorderWidth := 1; Result.GRushButton1.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton10 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 296).SetSize(41, 17)); Result.GRushButton10.Font.FontStyle := []; - //Result.GRushButton10.Font.FontHeight := 8; + Result.GRushButton10.Font.FontHeight := 8; Result.GRushButton10.All_BorderRoundWidth := 0; Result.GRushButton10.All_BorderRoundHeight := 0; Result.GRushButton10.Down_BorderWidth := 1; Result.GRushButton10.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton14 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Reset state').SetPosition(176, 4).SetSize(65, 17)); Result.GRushButton14.Font.FontStyle := []; - //Result.GRushButton14.Font.FontHeight := 8; + Result.GRushButton14.Font.FontHeight := 8; Result.GRushButton14.All_BorderRoundWidth := 0; Result.GRushButton14.All_BorderRoundHeight := 0; Result.GRushButton14.Down_BorderWidth := 1; Result.GRushButton14.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton18 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 176).SetSize(41, 17)); Result.GRushButton18.Font.FontStyle := []; - //Result.GRushButton18.Font.FontHeight := 8; + Result.GRushButton18.Font.FontHeight := 8; Result.GRushButton18.All_BorderRoundWidth := 0; Result.GRushButton18.All_BorderRoundHeight := 0; Result.GRushButton18.Down_BorderWidth := 1; Result.GRushButton18.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton2 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 56).SetSize(41, 17)); Result.GRushButton2.Font.FontStyle := []; - //Result.GRushButton2.Font.FontHeight := 8; + Result.GRushButton2.Font.FontHeight := 8; Result.GRushButton2.All_BorderRoundWidth := 0; Result.GRushButton2.All_BorderRoundHeight := 0; Result.GRushButton2.Down_BorderWidth := 1; Result.GRushButton2.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton3 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 80).SetSize(41, 17)); Result.GRushButton3.Font.FontStyle := []; - //Result.GRushButton3.Font.FontHeight := 8; + Result.GRushButton3.Font.FontHeight := 8; Result.GRushButton3.All_BorderRoundWidth := 0; Result.GRushButton3.All_BorderRoundHeight := 0; Result.GRushButton3.Down_BorderWidth := 1; Result.GRushButton3.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton4 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 104).SetSize(41, 17)); Result.GRushButton4.Font.FontStyle := []; - //Result.GRushButton4.Font.FontHeight := 8; + Result.GRushButton4.Font.FontHeight := 8; Result.GRushButton4.All_BorderRoundWidth := 0; Result.GRushButton4.All_BorderRoundHeight := 0; Result.GRushButton4.Down_BorderWidth := 1; Result.GRushButton4.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton5 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 128).SetSize(41, 17)); Result.GRushButton5.Font.FontStyle := []; - //Result.GRushButton5.Font.FontHeight := 8; + Result.GRushButton5.Font.FontHeight := 8; Result.GRushButton5.All_BorderRoundWidth := 0; Result.GRushButton5.All_BorderRoundHeight := 0; Result.GRushButton5.Down_BorderWidth := 1; Result.GRushButton5.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton6 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 152).SetSize(41, 17)); Result.GRushButton6.Font.FontStyle := []; - //Result.GRushButton6.Font.FontHeight := 8; + Result.GRushButton6.Font.FontHeight := 8; Result.GRushButton6.All_BorderRoundWidth := 0; Result.GRushButton6.All_BorderRoundHeight := 0; Result.GRushButton6.Down_BorderWidth := 1; Result.GRushButton6.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton7 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 200).SetSize(41, 17)); Result.GRushButton7.Font.FontStyle := []; - //Result.GRushButton7.Font.FontHeight := 8; + Result.GRushButton7.Font.FontHeight := 8; Result.GRushButton7.All_BorderRoundWidth := 0; Result.GRushButton7.All_BorderRoundHeight := 0; Result.GRushButton7.Down_BorderWidth := 1; Result.GRushButton7.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton8 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 224).SetSize(41, 17)); Result.GRushButton8.Font.FontStyle := []; - //Result.GRushButton8.Font.FontHeight := 8; + Result.GRushButton8.Font.FontHeight := 8; Result.GRushButton8.All_BorderRoundWidth := 0; Result.GRushButton8.All_BorderRoundHeight := 0; Result.GRushButton8.Down_BorderWidth := 1; Result.GRushButton8.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton9 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 248).SetSize(41, 17)); Result.GRushButton9.Font.FontStyle := []; - //Result.GRushButton9.Font.FontHeight := 8; + Result.GRushButton9.Font.FontHeight := 8; Result.GRushButton9.All_BorderRoundWidth := 0; Result.GRushButton9.All_BorderRoundHeight := 0; Result.GRushButton9.Down_BorderWidth := 1; Result.GRushButton9.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GradStyles := NewComboBox(Result.GRushPanel2, [coReadOnly, coNoIntegralHeight]).SetPosition(112, 174).SetSize(81, 0); Result.GradStyles.Font.FontStyle := []; - //Result.GradStyles.Font.FontHeight := 8; + Result.GradStyles.Font.FontHeight := 8; Result.GradStyles.Color := clWindow; Result.GradStyles.Items[0] := 'Solid'; Result.GradStyles.Items[1] := 'Vertical'; diff --git a/Addons/MCKGRushSplitterEditor.pas b/Addons/MCKGRushSplitterEditor.pas index 5502a12..e77ac9b 100644 --- a/Addons/MCKGRushSplitterEditor.pas +++ b/Addons/MCKGRushSplitterEditor.pas @@ -268,19 +268,19 @@ begin Result.ButtonOK := PGRushControl(NewGRushButton(Result.Form, 'OK').SetPosition(272, 512).SetSize(105, 33)); Result.ButtonOK.Font.FontStyle := [fsBold]; Result.GRushButton15 := PGRushControl(NewGRushButton(Result.Form, 'Reset to souce').SetPosition(401, 408).SetSize(104, 17)); - //Result.GRushButton15.Font.FontHeight := 8; + Result.GRushButton15.Font.FontHeight := 8; Result.GRushButton15.All_BorderRoundWidth := 0; Result.GRushButton15.All_BorderRoundHeight := 0; Result.GRushButton15.Down_BorderWidth := 1; Result.GRushButton15.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton20 := PGRushControl(NewGRushButton(Result.Form, 'Reset to default').SetPosition(273, 408).SetSize(104, 17)); - //Result.GRushButton20.Font.FontHeight := 8; + Result.GRushButton20.Font.FontHeight := 8; Result.GRushButton20.All_BorderRoundWidth := 0; Result.GRushButton20.All_BorderRoundHeight := 0; Result.GRushButton20.Down_BorderWidth := 1; Result.GRushButton20.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.StatesList := NewComboBox(Result.Form, [coReadOnly, coNoIntegralHeight]).SetPosition(328, 10).SetSize(113, 0); - //Result.StatesList.Font.FontHeight := 8; + Result.StatesList.Font.FontHeight := 8; Result.StatesList.Color := clWindow; Result.StatesList.Items[0] := 'All states (w/o)'; Result.StatesList.Items[1] := 'Default state'; @@ -353,108 +353,108 @@ begin Result.Label32.Color := $E8D6CE; Result.B := NewEditBox(Result.GRushPanel1, []).SetPosition(208, 248).SetSize(33, 17); Result.B.Ctl3D := False; - //Result.B.Font.FontHeight := 8; + Result.B.Font.FontHeight := 8; Result.B.Text := '0'; Result.DotsCount := NewEditBox(Result.GRushPanel1, []).SetPosition(112, 272).SetSize(81, 17); Result.DotsCount.Ctl3D := False; - //Result.DotsCount.Font.FontHeight := 8; + Result.DotsCount.Font.FontHeight := 8; Result.DotsCount.Text := '0'; Result.GlyphHeight := NewEditBox(Result.GRushPanel1, []).SetPosition(200, 200).SetSize(41, 17); Result.GlyphHeight.Ctl3D := False; - //Result.GlyphHeight.Font.FontHeight := 8; + Result.GlyphHeight.Font.FontHeight := 8; Result.GlyphHeight.Text := '0'; Result.GlyphWidth := NewEditBox(Result.GRushPanel1, []).SetPosition(80, 200).SetSize(41, 17); Result.GlyphWidth.Ctl3D := False; - //Result.GlyphWidth.Font.FontHeight := 8; + Result.GlyphWidth.Font.FontHeight := 8; Result.GlyphWidth.Text := '0'; Result.L := NewEditBox(Result.GRushPanel1, []).SetPosition(28, 248).SetSize(33, 17); Result.L.Ctl3D := False; - //Result.L.Font.FontHeight := 8; + Result.L.Font.FontHeight := 8; Result.L.Text := '0'; Result.R := NewEditBox(Result.GRushPanel1, []).SetPosition(148, 248).SetSize(33, 17); Result.R.Ctl3D := False; - //Result.R.Font.FontHeight := 8; + Result.R.Font.FontHeight := 8; Result.R.Text := '0'; Result.Spacing := NewEditBox(Result.GRushPanel1, []).SetPosition(112, 296).SetSize(81, 17); Result.Spacing.Ctl3D := False; - //Result.Spacing.Font.FontHeight := 8; + Result.Spacing.Font.FontHeight := 8; Result.Spacing.Text := '0'; Result.T := NewEditBox(Result.GRushPanel1, []).SetPosition(88, 248).SetSize(33, 17); Result.T.Ctl3D := False; - //Result.T.Font.FontHeight := 8; + Result.T.Font.FontHeight := 8; Result.T.Text := '0'; Result.GRushButton11 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 80).SetSize(41, 17)); - //Result.GRushButton11.Font.FontHeight := 8; + Result.GRushButton11.Font.FontHeight := 8; Result.GRushButton11.All_BorderRoundWidth := 0; Result.GRushButton11.All_BorderRoundHeight := 0; Result.GRushButton11.Down_BorderWidth := 1; Result.GRushButton11.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton12 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 128).SetSize(41, 17)); - //Result.GRushButton12.Font.FontHeight := 8; + Result.GRushButton12.Font.FontHeight := 8; Result.GRushButton12.All_BorderRoundWidth := 0; Result.GRushButton12.All_BorderRoundHeight := 0; Result.GRushButton12.Down_BorderWidth := 1; Result.GRushButton12.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton13 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 176).SetSize(41, 17)); - //Result.GRushButton13.Font.FontHeight := 8; + Result.GRushButton13.Font.FontHeight := 8; Result.GRushButton13.All_BorderRoundWidth := 0; Result.GRushButton13.All_BorderRoundHeight := 0; Result.GRushButton13.Down_BorderWidth := 1; Result.GRushButton13.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton16 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 224).SetSize(41, 17)); - //Result.GRushButton16.Font.FontHeight := 8; + Result.GRushButton16.Font.FontHeight := 8; Result.GRushButton16.All_BorderRoundWidth := 0; Result.GRushButton16.All_BorderRoundHeight := 0; Result.GRushButton16.Down_BorderWidth := 1; Result.GRushButton16.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton17 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 296).SetSize(41, 17)); - //Result.GRushButton17.Font.FontHeight := 8; + Result.GRushButton17.Font.FontHeight := 8; Result.GRushButton17.All_BorderRoundWidth := 0; Result.GRushButton17.All_BorderRoundHeight := 0; Result.GRushButton17.Down_BorderWidth := 1; Result.GRushButton17.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton19 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 320).SetSize(41, 17)); - //Result.GRushButton19.Font.FontHeight := 8; + Result.GRushButton19.Font.FontHeight := 8; Result.GRushButton19.All_BorderRoundWidth := 0; Result.GRushButton19.All_BorderRoundHeight := 0; Result.GRushButton19.Down_BorderWidth := 1; Result.GRushButton19.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton21 := PGRushControl(NewGRushButton(Result.GRushPanel1, 'Default').SetPosition(200, 272).SetSize(41, 17)); - //Result.GRushButton21.Font.FontHeight := 8; + Result.GRushButton21.Font.FontHeight := 8; Result.GRushButton21.All_BorderRoundWidth := 0; Result.GRushButton21.All_BorderRoundHeight := 0; Result.GRushButton21.Down_BorderWidth := 1; Result.GRushButton21.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GlyphHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 102).SetSize(57, 0); - //Result.GlyphHorz.Font.FontHeight := 8; + Result.GlyphHorz.Font.FontHeight := 8; Result.GlyphHorz.Color := clWindow; Result.GlyphHorz.Items[0] := 'Left'; Result.GlyphHorz.Items[1] := 'Center'; Result.GlyphHorz.Items[2] := 'Right'; Result.GlyphHorz.CurIndex := 0; Result.GlyphVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 102).SetSize(57, 0); - //Result.GlyphVert.Font.FontHeight := 8; + Result.GlyphVert.Font.FontHeight := 8; Result.GlyphVert.Color := clWindow; Result.GlyphVert.Items[0] := 'Top'; Result.GlyphVert.Items[1] := 'Center'; Result.GlyphVert.Items[2] := 'Bottom'; Result.GlyphVert.CurIndex := 0; Result.TextHorz := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(64, 150).SetSize(57, 0); - //Result.TextHorz.Font.FontHeight := 8; + Result.TextHorz.Font.FontHeight := 8; Result.TextHorz.Color := clWindow; Result.TextHorz.Items[0] := 'Left'; Result.TextHorz.Items[1] := 'Center'; Result.TextHorz.Items[2] := 'Right'; Result.TextHorz.CurIndex := 0; Result.TextVert := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(184, 150).SetSize(57, 0); - //Result.TextVert.Font.FontHeight := 8; + Result.TextVert.Font.FontHeight := 8; Result.TextVert.Color := clWindow; Result.TextVert.Items[0] := 'Top'; Result.TextVert.Items[1] := 'Center'; Result.TextVert.Items[2] := 'Bottom'; Result.TextVert.CurIndex := 0; Result.UpdateSpeed := NewComboBox(Result.GRushPanel1, [coReadOnly, coNoIntegralHeight]).SetPosition(112, 318).SetSize(81, 21); - //Result.UpdateSpeed.Font.FontHeight := 8; + Result.UpdateSpeed.Font.FontHeight := 8; Result.UpdateSpeed.Color := clWindow; Result.UpdateSpeed.Items[0] := 'Immediately'; Result.UpdateSpeed.Items[1] := 'Very fast'; @@ -607,114 +607,114 @@ begin Result.BorderHe := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 272).SetSize(41, 17); Result.BorderHe.Ctl3D := False; Result.BorderHe.Font.FontStyle := []; - //Result.BorderHe.Font.FontHeight := 8; + Result.BorderHe.Font.FontHeight := 8; Result.BorderWi := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 272).SetSize(41, 17); Result.BorderWi.Ctl3D := False; Result.BorderWi.Font.FontStyle := []; - //Result.BorderWi.Font.FontHeight := 8; + Result.BorderWi.Font.FontHeight := 8; Result.BorderWidth := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 200).SetSize(81, 17); Result.BorderWidth.Ctl3D := False; Result.BorderWidth.Font.FontStyle := []; - //Result.BorderWidth.Font.FontHeight := 8; + Result.BorderWidth.Font.FontHeight := 8; Result.GlyphX := NewEditBox(Result.GRushPanel2, []).SetPosition(80, 320).SetSize(41, 17); Result.GlyphX.Ctl3D := False; Result.GlyphX.Font.FontStyle := []; - //Result.GlyphX.Font.FontHeight := 8; + Result.GlyphX.Font.FontHeight := 8; Result.GlyphY := NewEditBox(Result.GRushPanel2, []).SetPosition(200, 320).SetSize(41, 17); Result.GlyphY.Ctl3D := False; Result.GlyphY.Font.FontStyle := []; - //Result.GlyphY.Font.FontHeight := 8; + Result.GlyphY.Font.FontHeight := 8; Result.ShadowOffset := NewEditBox(Result.GRushPanel2, []).SetPosition(112, 224).SetSize(81, 17); Result.ShadowOffset.Ctl3D := False; Result.ShadowOffset.Font.FontStyle := []; - //Result.ShadowOffset.Font.FontHeight := 8; + Result.ShadowOffset.Font.FontHeight := 8; Result.GRushButton1 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 32).SetSize(41, 17)); Result.GRushButton1.Font.FontStyle := []; - //Result.GRushButton1.Font.FontHeight := 8; + Result.GRushButton1.Font.FontHeight := 8; Result.GRushButton1.All_BorderRoundWidth := 0; Result.GRushButton1.All_BorderRoundHeight := 0; Result.GRushButton1.Down_BorderWidth := 1; Result.GRushButton1.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton10 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 296).SetSize(41, 17)); Result.GRushButton10.Font.FontStyle := []; - //Result.GRushButton10.Font.FontHeight := 8; + Result.GRushButton10.Font.FontHeight := 8; Result.GRushButton10.All_BorderRoundWidth := 0; Result.GRushButton10.All_BorderRoundHeight := 0; Result.GRushButton10.Down_BorderWidth := 1; Result.GRushButton10.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton14 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Reset state').SetPosition(176, 4).SetSize(65, 17)); Result.GRushButton14.Font.FontStyle := []; - //Result.GRushButton14.Font.FontHeight := 8; + Result.GRushButton14.Font.FontHeight := 8; Result.GRushButton14.All_BorderRoundWidth := 0; Result.GRushButton14.All_BorderRoundHeight := 0; Result.GRushButton14.Down_BorderWidth := 1; Result.GRushButton14.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton18 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 176).SetSize(41, 17)); Result.GRushButton18.Font.FontStyle := []; - //Result.GRushButton18.Font.FontHeight := 8; + Result.GRushButton18.Font.FontHeight := 8; Result.GRushButton18.All_BorderRoundWidth := 0; Result.GRushButton18.All_BorderRoundHeight := 0; Result.GRushButton18.Down_BorderWidth := 1; Result.GRushButton18.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton2 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 56).SetSize(41, 17)); Result.GRushButton2.Font.FontStyle := []; - //Result.GRushButton2.Font.FontHeight := 8; + Result.GRushButton2.Font.FontHeight := 8; Result.GRushButton2.All_BorderRoundWidth := 0; Result.GRushButton2.All_BorderRoundHeight := 0; Result.GRushButton2.Down_BorderWidth := 1; Result.GRushButton2.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton3 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 80).SetSize(41, 17)); Result.GRushButton3.Font.FontStyle := []; - //Result.GRushButton3.Font.FontHeight := 8; + Result.GRushButton3.Font.FontHeight := 8; Result.GRushButton3.All_BorderRoundWidth := 0; Result.GRushButton3.All_BorderRoundHeight := 0; Result.GRushButton3.Down_BorderWidth := 1; Result.GRushButton3.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton4 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 104).SetSize(41, 17)); Result.GRushButton4.Font.FontStyle := []; - //Result.GRushButton4.Font.FontHeight := 8; + Result.GRushButton4.Font.FontHeight := 8; Result.GRushButton4.All_BorderRoundWidth := 0; Result.GRushButton4.All_BorderRoundHeight := 0; Result.GRushButton4.Down_BorderWidth := 1; Result.GRushButton4.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton5 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 128).SetSize(41, 17)); Result.GRushButton5.Font.FontStyle := []; - //Result.GRushButton5.Font.FontHeight := 8; + Result.GRushButton5.Font.FontHeight := 8; Result.GRushButton5.All_BorderRoundWidth := 0; Result.GRushButton5.All_BorderRoundHeight := 0; Result.GRushButton5.Down_BorderWidth := 1; Result.GRushButton5.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton6 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 152).SetSize(41, 17)); Result.GRushButton6.Font.FontStyle := []; - //Result.GRushButton6.Font.FontHeight := 8; + Result.GRushButton6.Font.FontHeight := 8; Result.GRushButton6.All_BorderRoundWidth := 0; Result.GRushButton6.All_BorderRoundHeight := 0; Result.GRushButton6.Down_BorderWidth := 1; Result.GRushButton6.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton7 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 200).SetSize(41, 17)); Result.GRushButton7.Font.FontStyle := []; - //Result.GRushButton7.Font.FontHeight := 8; + Result.GRushButton7.Font.FontHeight := 8; Result.GRushButton7.All_BorderRoundWidth := 0; Result.GRushButton7.All_BorderRoundHeight := 0; Result.GRushButton7.Down_BorderWidth := 1; Result.GRushButton7.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton8 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 224).SetSize(41, 17)); Result.GRushButton8.Font.FontStyle := []; - //Result.GRushButton8.Font.FontHeight := 8; + Result.GRushButton8.Font.FontHeight := 8; Result.GRushButton8.All_BorderRoundWidth := 0; Result.GRushButton8.All_BorderRoundHeight := 0; Result.GRushButton8.Down_BorderWidth := 1; Result.GRushButton8.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GRushButton9 := PGRushControl(NewGRushButton(Result.GRushPanel2, 'Default').SetPosition(200, 248).SetSize(41, 17)); Result.GRushButton9.Font.FontStyle := []; - //Result.GRushButton9.Font.FontHeight := 8; + Result.GRushButton9.Font.FontHeight := 8; Result.GRushButton9.All_BorderRoundWidth := 0; Result.GRushButton9.All_BorderRoundHeight := 0; Result.GRushButton9.Down_BorderWidth := 1; Result.GRushButton9.All_ContentOffsets := MakeRect(0, 0, 0, 0); Result.GradStyles := NewComboBox(Result.GRushPanel2, [coReadOnly, coNoIntegralHeight]).SetPosition(112, 174).SetSize(81, 0); Result.GradStyles.Font.FontStyle := []; - //Result.GradStyles.Font.FontHeight := 8; + Result.GradStyles.Font.FontHeight := 8; Result.GradStyles.Color := clWindow; Result.GradStyles.Items[0] := 'Solid'; Result.GradStyles.Items[1] := 'Vertical'; diff --git a/Addons/Objects.pas b/Addons/Objects.pas index 2292be8..f0f8a40 100644 --- a/Addons/Objects.pas +++ b/Addons/Objects.pas @@ -112,7 +112,7 @@ begin if InstBlockCount = 0 then begin VirtualFree(InstBlockList, 0, MEM_RELEASE); InstBlockList := nil; - ObjectInstance := nil; +// ObjectInstance := nil; end; end; end; diff --git a/Addons/ToGrush.pas b/Addons/ToGrush.pas index d9e95a8..53da715 100644 --- a/Addons/ToGrush.pas +++ b/Addons/ToGrush.pas @@ -1,7 +1,27 @@ +{ ToGRush -- (C) by Vladimir Kladov, 2010 +This version is compatible only with KOL + Grush Controls of version 3.00+ + +Purpose: provides easy way to convert KOL project to use Grush controls +inplace of standard Windows controls. To use it in most cases it is +sufficiently to add ToGrush into uses clause after the KOL.pas, KOLadd.pas +and other KOL units. Use also symbols defined below to change options. +Note, that with symbol TOGRUSH_OPTIONAL, it is possible to create dual view +project, controlling if Grush controls are used or not via a variable +NoGrush. + +KOLGRushControls are created (C) by Karpinsky Alexander aka homm in 2007. +} + unit ToGRush; interface +{$I KOLDEF.inc} + +{$IFDEF EXTERNAL_DEFINES} + {$INCLUDE EXTERNAL_DEFINES.INC} +{$ENDIF EXTERNAL_DEFINES} + //{$DEFINE TOGRUSH_AUTO_DISIMAGES} // add this symbol to provide 256 gray images // based on original ones for Disabled state // of toolbar buttons @@ -11,7 +31,13 @@ interface //{$DEFINE TOGRUSH_NO_AUTO_SIZE_BTNS} // not use AutoSize for buttons // (sensible only in a case, when only images are in the toolbar) -uses Windows, KOL, KOLGRushControls; +//{$DEFINE TOGRUSH_NO_MESSAGEBOX} // not use MessageBox replacement +//{$DEFINE TOGRUSH_NO_SCROLLBARS} // not convert scrollbar colors for ScrollBar controls + +//{$DEFINE TOGRUSH_OPTIONAL} // define it to allow controlling if actually use GRush controls or not + // (via variable NoGRush) + +uses Windows, Messages, KOL, KOLGRushControls; function NewButton( AParent: PControl; const Caption: KOLString ): PControl; @@ -24,23 +50,112 @@ function NewSplitter( AParent: PControl; MinSizePrev, MinSizeNext: Integer ): PC function NewSplitterEx( AParent: PControl; MinSizePrev, MinSizeNext: Integer; EdgeStyle: TEdgeStyle ): PControl; - +var GRush_Force_Flat_Toolbars: Boolean; function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions; - Bitmap: HBitmap; const Buttons: array of PChar; + Bitmap: HBitmap; const Buttons: array of PKOLChar; const BtnImgIdxArray: array of Integer ) : PControl; - +procedure ToolbarAddButtons( Toolbar: PControl; const Buttons: array of PKOLChar; + const BtnImgIdxArray: array of Integer; Bitmap: HBitmap ); function ToolbarButtonRect( Toolbar: PControl; BtnID: Integer ): TRect; procedure ToolbarSetTooltips( Toolbar: PControl; BtnID1st: Integer; const Tooltips: array of PKOLChar ); function ToolbarButtonEnabled( Toolbar: PControl; BtnID: Integer ): Boolean; +function ToolbarButtonChecked( Toolbar: PControl; BtnID: Integer): Boolean; +procedure ToolbarButtonSetChecked( Toolbar: PControl; BtnID: Integer; Checked: Boolean ); procedure EnableToolbarButton( Toolbar: PControl; BtnID: Integer; Enable: Boolean ); function ToolbarButtonVisible( Toolbar: PControl; BtnID: Integer ): Boolean; procedure ShowHideToolbarButton( Toolbar: PControl; BtnID: Integer; Show: Boolean ); + function NewProgressbar( AParent: PControl ): PControl; function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PControl; +{$IFNDEF TOGRUSH_NO_MESSAGEBOX} +function MessageBox( Wnd: HWnd; msg, title: PChar; flags: DWORD ): Integer; stdcall; +{$ENDIF} + +{$IFNDEF TOGRUSH_NO_SCROLLBARS} +function NewScrollBar( AParent: PControl; BarSide: TScrollerBar ): PControl; +function Scrollbar_GetMinPos( sb: PControl ): Integer; +procedure Scrollbar_SetMinPos( sb: PControl; m: Integer ); +procedure Scrollbar_SetAll( sb: PControl; min, max, pg, cur: Integer ); +function Scrollbar_GetMaxPos( sb: PControl ): Integer; +procedure Scrollbar_SetMaxPos( sb: PControl; m: Integer ); +function Scrollbar_GetCurPos( sb: PControl ): Integer; +procedure Scrollbar_SetCurPos( sb: PControl; newp: Integer ); +procedure Scrollbar_SetPageSz( sb: PControl; psz: Integer ); +function Scrollbar_GetPageSz( sb: PControl ): Integer; +procedure Scrollbar_SetLineSz( sb: PControl; lnz: Integer ); +function Scrollbar_GetLineSz( sb: PControl ): Integer; + +{$IFNDEF TOGRUSH_NO_WINDOW_SCROLLBARS} +procedure OverrideScrollbars( C: PControl ); +{$ENDIF} + +{$ENDIF} + +{$IFNDEF TOGRUSH_NO_COMBO_EDIT} +function NewComboBox( AParent: PControl; Options: TComboOptions ): PControl; +function NewEditBox( AParent: PControl; Options: TEditOptions ): PControl; +{$ENDIF} + +{$IFNDEF TOGRUSH_NO_GRADIENTPANEL} +function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl; +function NewGradientPanelEx( AParent: PControl; Color1, Color2: TColor; + Style: TGradientStyle; Layout: TGradientLayout ): PControl; +{$ENDIF} + +{$DEFINE ROUND_RADIOITEMS} // if commented, the same as check boxes +{$DEFINE RED_ACCELERATORS} // if commented, accelerators are drawn using underline as usual +//{$DEFINE RED_GREEN_ACCELS} // too colored! +function OwnerDrawMenuItem( var Msg: TMsg; const Menus: array of PMenu; + var Rslt: Integer): Boolean; +var MenuHighlight: TColor = clGRushHiLight; + MenuBackground: TColor = clGRushLighten; //$EBE3DD + MenuTextColor: TColor = clBlack; + MenuTextHighlight: TColor = clWhite; + MenuTextDisabled: TColor = clGray; + MenuTextDisabSel: TColor = clSilver; + MenuLine1Color: TColor = clBlack; + MenuLine2Color: TColor = clGRushLight; + MenuCheckBoxBkColor: TColor = clWhite; + MenuCheckBoxBorder: TColor = clBlack; + MenucheckBoxCheck: TColor = clGRushHiLight; + MenuAccelColor: TColor = {$IFDEF RED_GREEN_ACCELS} clRed {$ELSE} clBlue {$ENDIF}; + MenuAccelSelColor: TColor = {$IFDEF RED_GREEN_ACCELS} clLime {$ELSE} clNavy {$ENDIF}; + MenuAccelDisabled: TColor = clDkGray; + MenuAccelSelDisabled: TColor = clDkGray; + MenuHotKeyTextColor: TColor = {$IFDEF RED_GREEN_ACCELS} clBlue {$ELSE} clGRushHiLight {$ENDIF}; + MenuHotKeySelTxColor: TColor = clNavy; + MenuHotKeyTxDisabled: TColor = clDkGray; + MenuHotKeySelTxDisabled: TColor = clDkGray; + +{ To use OwnerDrawMenuItem: + 1. set OwnerDraw to TRUE for all menu items; + 2. in Form.OnMessage, write following code: + +function TForm1.KOLForm1Message(var Msg: tagMSG; + var Rslt: Integer): Boolean; +begin + Result := FALSE; + if (Msg.message = WM_DRAWITEM) or (Msg.message = WM_MEASUREITEM) then + begin + Result := OwnerDrawMenuItem( Msg, [ PopupMenu1, PopupMenu2, PopupMenu3, PopupMenu4 ], + Rslt ); + end + else ....... +} + +{$IFDEF TOGRUSH_OPTIONAL} +var NoGrush: Boolean; +{$ENDIF TOGRUSH_OPTIONAL} + +function TriangleUpBitmap( Horizontal: Boolean ): PBitmap; +function TriangleDnBitmap( Horizontal: Boolean ): PBitmap; + implementation +uses KOLadd; + const IS_DRDWN = 16; type @@ -53,18 +168,47 @@ type //////////////////////////////////////////////////////////////////////////////// function NewButton( AParent: PControl; const Caption: KOLString ): PControl; begin - Result := Pointer( NewGRushButton( AParent, Caption ).SetSize( 64, 22 ) ); - PControl_( Result ).fIsButton := TRUE; + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + begin + Result := Pointer( NewGRushButton( AParent, Caption ).SetSize( 64, 22 ) ); + {$IFDEF USE_FLAGS} include( PControl_( Result ).fFlagsG5, G5_IsButton ); + {$ELSE} PControl_( Result ).fIsButton := TRUE; {$ENDIF} + end + {$IFDEF TOGRUSH_OPTIONAL} + else + begin + Result := Kol.NewButton( AParent, Caption ) + end + {$ENDIF TOGRUSH_OPTIONAL} + ; end; function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl; begin - Result := Pointer( NewGRushCheckBox( AParent, Caption ).SetSize( 64, 22 ) ); + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + Result := Pointer( NewGRushCheckBox( AParent, Caption ).SetSize( 64, 22 ) ) + {$IFDEF TOGRUSH_OPTIONAL} + else + Result := Kol.NewCheckBox( AParent, Caption ) + {$ENDIF TOGRUSH_OPTIONAL} + ; end; function NewRadiobox( AParent: PControl; const Caption: KOLString ): PControl; begin - Result := Pointer( NewGRushRadioBox( AParent, Caption ).SetSize( 64, 22 ) ); + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + Result := Pointer( NewGRushRadioBox( AParent, Caption ).SetSize( 64, 22 ) ) + {$IFDEF TOGRUSH_OPTIONAL} + else + Result := Kol.NewRadiobox( AParent, Caption ) + {$ENDIF TOGRUSH_OPTIONAL} + ; end; //////////////////////////////////////////////////////////////////////////////// @@ -72,13 +216,23 @@ end; //////////////////////////////////////////////////////////////////////////////// function NewPanel( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl; begin - if EdgeStyle = esTransparent then + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} begin - Result := KOL.NewPanel( AParent, esNone ).SetSize( 64, 64 ); - Result.Transparent := TRUE; + if EdgeStyle >= esTransparent then + begin + Result := KOL.NewPanel( AParent, esNone ).SetSize( 64, 64 ); + if EdgeStyle = esTransparent then + Result.Transparent := TRUE; + end + else + Result := Pointer( NewGRushPanel( AParent ) ); end - else - Result := Pointer( NewGRushPanel( AParent ) ); + {$IFDEF TOGRUSH_OPTIONAL} + else Result := Kol.NewPanel( AParent, EdgeStyle ) + {$ENDIF TOGRUSH_OPTIONAL} + ; end; //////////////////////////////////////////////////////////////////////////////// @@ -86,15 +240,33 @@ end; //////////////////////////////////////////////////////////////////////////////// function NewSplitter( AParent: PControl; MinSizePrev, MinSizeNext: Integer ): PControl; begin - Result := Pointer( NewGRushSplitter( AParent, MinSizePrev, MinSizeNext ) ); - Result.Transparent := TRUE; + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + begin + Result := Pointer( NewGRushSplitter( AParent, MinSizePrev, MinSizeNext ) ); + Result.Transparent := TRUE; + end + {$IFDEF TOGRUSH_OPTIONAL} + else Result := Kol.NewSplitter( AParent, MinSizePrev, MinSizeNext ) + {$ENDIF TOGRUSH_OPTIONAL} + ; end; function NewSplitterEx( AParent: PControl; MinSizePrev, MinSizeNext: Integer; EdgeStyle: TEdgeStyle ): PControl; begin - Result := Pointer( NewGRushSplitter( AParent, MinSizePrev, MinSizeNext ) ); - Result.Transparent := TRUE; + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + begin + Result := Pointer( NewGRushSplitter( AParent, MinSizePrev, MinSizeNext ) ); + Result.Transparent := TRUE; + end + {$IFDEF TOGRUSH_OPTIONAL} + else Result := Kol.NewSplitterEx( AParent, MinSizePrev, MinSizeNext, EdgeStyle ) + {$ENDIF TOGRUSH_OPTIONAL} + ; end; //////////////////////////////////////////////////////////////////////////////// @@ -119,23 +291,42 @@ begin Checked := HiWord( D ) and 4 <> 0; if IsCheck then begin - Checked := not Checked; - D := D xor $40000; - SetProp( Sender.Handle, 'GRBTN', D ); - PGrushControl( Sender ).Checked := Checked; + Checked := not Checked; + D := D xor $40000; + SetProp( Sender.Handle, 'GRBTN', D ); + PGrushControl( Sender ).Checked := Checked; end; Toolbar := Pointer( Sender.Parent ); - if Assigned( Toolbar.fTBEvents ) and - (Toolbar.fTBevents.Count > Idx) then + if Assigned( Toolbar.DF.fTBEvents ) and + (Toolbar.DF.fTBevents.Count > Idx) then begin - EventRec := Toolbar.fTBevents.Items[ Idx ]; - if Assigned( EventRec.Event ) then - EventRec.Event( Toolbar, EventRec.BtnID ); + EventRec := Toolbar.DF.fTBevents.Items[ Idx ]; + if Assigned( EventRec.Event ) then + EventRec.Event( Toolbar, EventRec.BtnID ); end else - if Assigned( Toolbar.fOnClick ) then + {$IFDEF NIL_EVENTS} + if Assigned( Toolbar.EV.fOnClick ) then + {$ENDIF} begin - Toolbar.fOnClick( Toolbar ); + PControl_( Toolbar ).fCurIndex := PControl_( Toolbar ).fChildren.IndexOf( Sender ); + Toolbar.EV.fOnClick( Toolbar ); + end; +end; + +procedure ToGR_ButtonMouseMove( Dummy, Sender: PControl; var M: TMouseEventData ); +var P: TPoint; + M1: TMouseEventData; +begin + if Assigned( Sender.Parent.OnMouseMove ) then + begin + P := MakePoint( M.X, M.Y ); + P := Sender.Client2Screen( P ); + P := Sender.Parent.Screen2Client( P ); + M1 := M; + M1.X := P.X; + M1.Y := P.Y; + Sender.Parent.OnMouseMove( Sender.Parent, M1 ); end; end; @@ -152,25 +343,27 @@ begin {$ELSE} Toolbar := Pointer( Toolbar.Parent ); {$ENDIF} - Toolbar.fCurItem := Idx; + Toolbar.DF.fTBCurItem := Idx; Toolbar.fCurIndex := Idx; - Toolbar.fDropped := TRUE; - if Assigned( Toolbar.fTBevents ) and - (Toolbar.fTBevents.Count > Idx) then + Toolbar.DF.fTBDropped := TRUE; + if Assigned( Toolbar.DF.fTBevents ) and + (Toolbar.DF.fTBevents.Count > Idx) then begin - EventRec := Toolbar.fTBevents.Items[ Idx ]; - Toolbar.fCurItem := EventRec.BtnID; + EventRec := Toolbar.DF.fTBevents.Items[ Idx ]; + Toolbar.DF.fTBCurItem := EventRec.BtnID; end; - if Assigned( Toolbar.OnTBDropDown ) then + if Assigned( Toolbar.EV.fOnDropDown ) then begin - Toolbar.OnTBDropDown( Toolbar ); + Toolbar.EV.fOnDropDown( Toolbar ); end else - if Assigned( Toolbar.fOnClick ) then + {$IFDEF NIL_EVENTS} + if Assigned( Toolbar.EV.fOnClick ) then + {$ENDIF} begin - Toolbar.fOnClick( Toolbar ); + Toolbar.EV.fOnClick( Toolbar ); end; - Toolbar.fDropped := FALSE; + Toolbar.DF.fTBDropped := FALSE; end; procedure Provide_DIS_images( var B: PBitmap ); @@ -225,34 +418,46 @@ end; var DrDownBmp: PBitmap; function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions; - Bitmap: HBitmap; const Buttons: array of PChar; + Bitmap: HBitmap; const Buttons: array of PKOLChar; const BtnImgIdxArray: array of Integer ) : PControl; -var i, BtnID: Integer; - B, B2: PGRushControl; - C: String; - IsSep: Boolean; - IsDropDown: Boolean; - IsCheck, Checked, IsRadio: Boolean; - Idx: Integer; - D: DWORD; - imgW, imgH, W, H: Integer; +var //i, BtnID: Integer; + //B, B2: PGRushControl; + {$IFDEF GRAPHCTL_XPSTYLES} + pb: PControl; + {$ENDIF} + //C: String; + //IsSep: Boolean; + //IsDropDown: Boolean; + //IsCheck, Checked, IsRadio: Boolean; + //Idx: Integer; + //D: DWORD; + //imgW, imgH, W, + H: Integer; Bmp: PBitmap; - DD_dst: PByte; - y: Integer; + //DD_dst: PByte; + //y: Integer; ES: TEdgeStyle; const DD_img: array[ 0..6 ] of Byte = ( $0, $F8, $F8, $70, $70, $20, $20 ); begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Result := Kol.NewToolbar( AParent, Align, Options, Bitmap, Buttons, BtnImgIdxArray ); + Exit; + end; + {$ENDIF TOGRUSH_OPTIONAL} if Align = caNone then Align := caTop; H := 0; - imgW := 0; - imgH := 0; + + //imgW := 0; + //imgH := 0; Bmp := nil; - if Bitmap <> 0 then + if (Bitmap <> 0) and (Bitmap <> THandle( -1 )) then begin Bmp := NewBitmap( 0, 0 ); Bmp.Handle := Bitmap; - imgH := Bmp.Height; - imgW := imgH; + //imgH := Bmp.Height; + //imgW := imgH; H := Bmp.Height + 12; //Bmp.PixelFormat := pf32bit; //Bmp.SaveToFile( GetStartDir + 'test_toolbar1.bmp' ); @@ -260,11 +465,17 @@ begin Provide_DIS_images( Bmp ); {$ENDIF} end; + ES := esNone; - if [tboTransparent, tboFlat] * Options <> [] then + if ([tboTransparent, tboFlat] * Options <> []) or GRush_Force_Flat_Toolbars then + begin ES := esTransparent; + {if not( tboTransparent in Options ) then + ES := esSolid;} + end; Result := Pointer( NewPanel( AParent, ES ).SetSize( 0, H ).SetAlign(Align) ); - //if Bmp <> nil then Result.Add2AutoFree( Bmp ); + ToolbarAddButtons( Result, Buttons, BtnImgIdxArray, Bitmap ); + (* Idx := -1; for i := 0 to High( Buttons ) do begin @@ -273,7 +484,7 @@ begin IsDropDown := FALSE; IsCheck := FALSE; Checked := FALSE; - BtnID := i; //ToolbarsIDcmd; inc( ToolbarsIDcmd ); + BtnID := i; if IsSep then C := '' else begin @@ -288,10 +499,24 @@ begin IsRadio := (C <> '') and (C[ 1 ] = '!'); if IsRadio then Delete( C, 1, 1 ); end; + {$IFDEF TOOLBAR_DOT_NOAUTOSIZE_BUTTON} + if (C <> '') and (C[ 1 ] = '.') then + Delete( C, 1, 1 ); + {$ENDIF TOOLBAR_DOT_NOAUTOSIZE_BUTTON} end; if Trim( C ) = '' then C := ''; if IsSep then + {$IFDEF GRAPHCTL_XPSTYLES} + begin + pb := NewPaintbox( Result ).SetSize( 6, 0 ).SetAlign( caLeft ); + pb.Transparent := TRUE; + end + {$ELSE} NewPanel( Result, esTransparent ).SetSize( 6, 0 ).SetAlign( caLeft ) + {$IFNDEF TOGRUSH_TOOLBAR_NOMOUSEMOVE} + .MouseTransparent + {$ENDIF} + {$ENDIF} else begin if C = '' then @@ -309,6 +534,9 @@ begin {$ENDIF USE_NAMES} B.Tabstop := FALSE; B.LikeSpeedButton; + {$IFNDEF TOGRUSH_TOOLBAR_NOMOUSEMOVE} + B.OnMouseMove := TOnMouse( MakeMethod( nil, @ ToGR_ButtonMouseMove ) ); + {$ENDIF} B.Transparent := TRUE; if IsSep then B.Enabled := FALSE; if B.GetWindowHandle <> 0 then @@ -341,9 +569,9 @@ begin B.All_GlyphHAlign := haCenter; end; {$IFNDEF TOGRUSH_NO_AUTO_SIZE_BTNS} - B.fCommandActions.aAutoSzX := 10 + ImgW; - if ImgW > 0 then inc( B.fCommandActions.aAutoSzX, 5 ); - if IsDropDown then inc( B.fCommandActions.aAutoSzX, 10 ); + B.aAutoSzX := 10 + ImgW; + if ImgW > 0 then inc( B.aAutoSzX, 5 ); + if IsDropDown then inc( B.aAutoSzX, 10 ); B.AutoSize( TRUE ); {$ENDIF} if IsDropDown then @@ -385,10 +613,7 @@ begin DD_dst := DrDownBmp.ScanLine[ y ]; DD_dst^ := not DD_img[ y ]; end; - //B2.All_GlyphItemX := 0; - //B.All_GlyphItemY := 0; B2.All_GlyphBitmap := DrDownBmp; - DrDownBmp.RefDec; end else begin @@ -401,16 +626,204 @@ begin end; end; end; + *) if Bmp <> nil then begin Bmp.Free; end; end; +procedure ToolbarAddButtons( Toolbar: PControl; const Buttons: array of PKOLChar; + const BtnImgIdxArray: array of Integer; Bitmap: HBitmap ); +var i, Idx, BtnID, W, H, ImgH, ImgW, y: Integer; + IsSep, IsDropDown, IsCheck, Checked, IsRadio: Boolean; + C: KOLString; + B, B2: PGrushControl; + D: DWORD; + Bmp: PBitmap; + DD_dst: PByte; +const DD_img: array[ 0..6 ] of Byte = ( $0, $F8, $F8, $70, $70, $20, $20 ); +begin + H := 0; + imgW := 0; + imgH := 0; + Bmp := nil; + if (Bitmap <> 0) and (Bitmap <> THandle( -1 )) then + begin + Bmp := NewBitmap( 0, 0 ); + Bmp.Handle := Bitmap; + imgH := Bmp.Height; + imgW := imgH; + H := Bmp.Height + 12; + {$IFDEF TOGRUSH_AUTO_DISIMAGES} + Provide_DIS_images( Bmp ); + {$ENDIF} + end; + Idx := -1; + for i := 0 to High( Buttons ) do + begin + C := Buttons[ i ]; + IsSep := C = '-'; + IsDropDown := FALSE; + IsCheck := FALSE; + Checked := FALSE; + BtnID := i; + if IsSep then C := '' + else + begin + Inc( Idx ); + IsDropDown := (C <> '') and (C[ 1 ] = '^'); + if IsDropDown then Delete( C, 1, 1 ); + IsCheck := (C <> '') and CharIn(C[1], [ '+', '-' ]); + if IsCheck then + begin + Checked := C[ 1 ] = '+'; + Delete( C, 1, 1 ); + IsRadio := (C <> '') and (C[ 1 ] = '!'); + if IsRadio then Delete( C, 1, 1 ); + end; + {$IFDEF TOOLBAR_DOT_NOAUTOSIZE_BUTTON} + if (C <> '') and (C[ 1 ] = '.') then + Delete( C, 1, 1 ); + {$ENDIF TOOLBAR_DOT_NOAUTOSIZE_BUTTON} + end; + if Trim( C ) = '' then C := ''; + if IsSep then + {$IFDEF GRAPHCTL_XPSTYLES} + begin + pb := NewPaintbox( Result ).SetSize( 6, 0 ).SetAlign( caLeft ); + pb.Transparent := TRUE; + end + {$ELSE} + NewPanel( Toolbar, esTransparent ).SetSize( 6, 0 ).SetAlign( caLeft ) + {$IFNDEF TOGRUSH_TOOLBAR_NOMOUSEMOVE} + .MouseTransparent + {$ENDIF} + {$ENDIF} + else + begin + if C = '' then + begin + W := 32; + if H <> 0 then W := H; + end + else + begin + W := 64; + end; + B := Pointer( NewButton( Toolbar, C ).SetSize( W, 0 ).SetAlign( caLeft ) ); + {$IFDEF USE_NAMES} + //B.Name := 'TB' + Int2Str( Idx+1 ); + {$ENDIF USE_NAMES} + B.Tabstop := FALSE; + B.LikeSpeedButton; + {$IFNDEF TOGRUSH_TOOLBAR_NOMOUSEMOVE} + B.OnMouseMove := TOnMouse( MakeMethod( nil, @ ToGR_ButtonMouseMove ) ); + {$ENDIF} + B.Transparent := TRUE; + if IsSep then B.Enabled := FALSE; + if B.GetWindowHandle <> 0 then + begin + D := i or Integer( IsSep ) shl 16 + or Integer( IsCheck ) shl 17 + or Integer( Checked ) shl 18 + or Integer( IsDropDown ) shl 19 + ; + SetProp( B.Handle, 'GRBTN', D ); + end; + SetProp( B.Handle, 'BTNID', BtnID ); + B.OnClick := TOnEvent( MakeMethod( nil, @ ToGR_ClickToolbarBtn ) ); + if Bmp <> nil then + begin + B.All_GlyphItemX := idx; + B.All_GlyphItemY := 0; + B.All_GlyphBitmap := Bmp; + B.All_GlyphWidth := ImgW; + B.All_GlyphHeight := ImgH; + //B.All_GlyphAttached := TRUE; + {$IFDEF TOGRUSH_AUTO_DISIMAGES} + B.Dis_GlyphItemX := idx; + B.Dis_GlyphItemY := 1; + B.All_GlyphBitmap := Bmp; + B.All_GlyphWidth := ImgW; + B.All_GlyphHeight := ImgH; + {$ENDIF} + if not IsDropDown and (C = '') then + B.All_GlyphHAlign := haCenter; + end; + {$IFNDEF TOGRUSH_NO_AUTO_SIZE_BTNS} + B.aAutoSzX := 10 + ImgW; + if ImgW > 0 then inc( B.aAutoSzX, 5 ); + if IsDropDown then inc( B.aAutoSzX, 10 ); + B.AutoSize( TRUE ); + {$ENDIF} + if IsDropDown then + begin + {$IFDEF TOGRUSH_DROPBTN2} + B2 := Pointer( NewButton( Result, C ).SetSize( 5 + 8, 0 ).SetAlign( caLeft ) ); + {$ELSE} + //B.AutoSize( FALSE ); + //B.Width := W + 13; + B.All_TextHAlign := haLeft; + B.Border := 2; + B2 := Pointer( NewButton( B, C ).SetSize( 5 + 8, 0 ).SetAlign( caRight ) ); + {$ENDIF} + {$IFDEF USE_NAMES} + //B2.Name := 'TB_dd' + Int2Str( Idx+1 ); + {$ENDIF USE_NAMES} + B2.Tabstop := FALSE; + B2.LikeSpeedButton; + B2.Transparent := TRUE; + PGrushControl( B2 ).All_BorderWidth := 0; + PGrushControl( B2 ).Over_BorderWidth := 1; + if B2.GetWindowHandle <> 0 then + begin + D := i or Integer( IsSep ) shl 16 + or Integer( IsCheck ) shl 17 + or Integer( Checked ) shl 18 + or Integer( IsDropDown ) shl 19 + or IS_DRDWN shl 16; + SetProp( B2.Handle, 'GRBTN', D ); + end; + B2.OnClick := TOnEvent( MakeMethod( nil, @ ToGR_ClickToolbarBtnDD ) ); + if DrDownBmp = nil then + begin + DrDownBmp := NewDIBBitmap( 5, High( DD_img )+1, pf1bit ); + DrDownBmp.DIBPalEntries[ 0 ] := $686868; + DrDownBmp.DIBPalEntries[ 1 ] := $FFFFFF; + for y := 0 to High( DD_img ) do + begin + DD_dst := DrDownBmp.ScanLine[ y ]; + DD_dst^ := not DD_img[ y ]; + end; + B2.All_GlyphBitmap := DrDownBmp; + end + else + begin + B2.All_GlyphBitmap := DrDownBmp; + end; + B2.All_GlyphWidth := 5; + B2.All_GlyphHeight := High( DD_img )+1; + B2.All_GlyphHAlign := haCenter; + B2.All_GlyphVAlign := vaBottom; + end; + end; + end; + if Bmp <> nil then + Bmp.Free; +end; + function ToolbarButtonRect( Toolbar: PControl; BtnID: Integer ): TRect; var i: Integer; B: PControl; begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Result := Kol.ToolbarButtonRect( Toolbar, BtnID ); + Exit; + end; + {$ENDIF TOGRUSH_OPTIONAL} for i := 0 to Toolbar.ChildCount-1 do begin B := Toolbar.Children[ i ]; @@ -432,6 +845,9 @@ var i, j: Integer; {$ENDIF} begin Toolbar.TBSetTooltips( BtnID1st, Tooltips ); + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then Exit; + {$ENDIF TOGRUSH_OPTIONAL} {$IFDEF USE_MHTOOLTIP} found := FALSE; j := 0; @@ -459,6 +875,13 @@ function ToolbarButtonEnabled( Toolbar: PControl; BtnID: Integer ): Boolean; var i: Integer; B: PControl; begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Result := Kol.ToolbarButtonEnabled( Toolbar, BtnID ); + Exit; + end; + {$ENDIF TOGRUSH_OPTIONAL} for i := 0 to Toolbar.ChildCount-1 do begin B := Toolbar.Children[ i ]; @@ -472,10 +895,64 @@ begin Result := FALSE; end; +function ToolbarButtonChecked( Toolbar: PControl; BtnID: Integer): Boolean; +var i: Integer; + B: PControl; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Result := Toolbar.TBButtonChecked[ BtnID ]; + Exit; + end; + {$ENDIF TOGRUSH_OPTIONAL} + for i := 0 to Toolbar.ChildCount-1 do + begin + B := Toolbar.Children[ i ]; + if (B.GetWindowHandle <> 0) and + (Integer( GetProp( B.Handle, 'BTNID' ) ) = BtnID) then + begin + Result := B.Checked; + Exit; + end; + end; + Result := FALSE; +end; + +procedure ToolbarButtonSetChecked( Toolbar: PControl; BtnID: Integer; Checked: Boolean ); +var i: Integer; + B: PControl; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Toolbar.TBButtonChecked[ BtnID ] := Checked; + Exit; + end; + {$ENDIF TOGRUSH_OPTIONAL} + for i := 0 to Toolbar.ChildCount-1 do + begin + B := Toolbar.Children[ i ]; + if (B.GetWindowHandle <> 0) and + (Integer( GetProp( B.Handle, 'BTNID' ) ) = BtnID) then + begin + B.Checked := Checked; + Exit; + end; + end; +end; + procedure EnableToolbarButton( Toolbar: PControl; BtnID: Integer; Enable: Boolean ); var i: Integer; B: PControl; begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Kol.EnableToolbarButton( Toolbar, BtnID, Enable ); + Exit; + end; + {$ENDIF TOGRUSH_OPTIONAL} for i := 0 to Toolbar.ChildCount-1 do begin B := Toolbar.Children[ i ]; @@ -492,6 +969,13 @@ function ToolbarButtonVisible( Toolbar: PControl; BtnID: Integer ): Boolean; var i: Integer; B: PControl; begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Result := Kol.ToolbarButtonVisible( Toolbar, BtnID ); + Exit; + end; + {$ENDIF TOGRUSH_OPTIONAL} for i := 0 to Toolbar.ChildCount-1 do begin B := Toolbar.Children[ i ]; @@ -509,6 +993,13 @@ procedure ShowHideToolbarButton( Toolbar: PControl; BtnID: Integer; Show: Boolea var i: Integer; B: PControl; begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Kol.ShowHideToolbarButton( Toolbar, BtnID, Show ); + Exit; + end; + {$ENDIF TOGRUSH_OPTIONAL} for i := 0 to Toolbar.ChildCount-1 do begin B := Toolbar.Children[ i ]; @@ -526,12 +1017,1707 @@ end; //////////////////////////////////////////////////////////////////////////////// function NewProgressbar( AParent: PControl ): PControl; begin - Result := Pointer( NewGRushProgressBar( AParent ).SetSize( 300, 20 ) ); + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + begin + Result := Pointer( NewGRushProgressBar( AParent ).SetSize( 300, 20 ) ); + PGRushControl( Result ).Def_BorderRoundWidth := 10; + PGRushControl( Result ).Def_BorderRoundHeight := 10; + end + {$IFDEF TOGRUSH_OPTIONAL} + else + Result := Kol.NewProgressbar( AParent ) + {$ENDIF TOGRUSH_OPTIONAL} + ; end; function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PControl; begin - Result := NewProgressbar( AParent ); + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + Result := NewProgressbar( AParent ) + {$IFDEF TOGRUSH_OPTIONAL} + else + Result := Kol.NewProgressbarEx( AParent, Options ); + {$ENDIF TOGRUSH_OPTIONAL} + ; end; +//////////////////////////////////////////////////////////////////////////////// +// MessageBox replacement +//////////////////////////////////////////////////////////////////////////////// +{$IFNDEF TOGRUSH_NO_MESSAGEBOX} +function MessageBox( Wnd: HWnd; msg, title: PChar; flags: DWORD ): Integer; stdcall; +var Answers: String; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Result := Windows.MessageBox( Wnd, msg, title, flags ); + Exit; + end; + {$ENDIF TOGRUSH_OPTIONAL} + CASE flags and 7 OF + MB_OK : Answers := 'OK'; + MB_OKCANCEL : Answers := 'OK/Cancel'; + MB_ABORTRETRYIGNORE : Answers := 'Abort/Retry/Ignore'; + MB_YESNOCANCEL : Answers := 'Yes/No/Cancel'; + MB_YESNO : Answers := 'Yes/No'; + MB_RETRYCANCEL : Answers := 'Retry/Cancel'; + END; + Result := ShowQuestionEx( msg, Answers, nil ); + CASE flags and 7 OF + MB_OK : Result := ID_OK; + MB_OKCANCEL : if Result <> ID_OK then Result := ID_CANCEL; + MB_ABORTRETRYIGNORE : CASE Result OF + 1: Result := ID_ABORT; + 2: Result := ID_RETRY; + else Result := ID_IGNORE; + END; + MB_YESNOCANCEL : CASE Result OF + 1: Result := ID_YES; + 2: Result := ID_NO; + else Result := ID_CANCEL; + END; + MB_YESNO : CASE Result OF + 1: Result := ID_YES; + else Result := ID_NO; + END; + MB_RETRYCANCEL : CASE Result OF + 1: Result := ID_RETRY; + else Result := ID_CANCEL; + END; + else Result := 0; + END; +end; +{$ENDIF} + + +var SBBrush: HBrush; +function WndProc_RecolorScrollbars( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean; +//var OldPaintDC: HDC; +begin + Result := FALSE; + CASE M.message OF + WM_CTLCOLORSCROLLBAR: + begin + //SetBkColor( M.wParam, clGRushLighten ); + if SBBrush = 0 then + SBBrush := CreateSolidBrush( ColorsMix( clGRushLighten, clGRushLight ) ); + Rslt := SBBrush; + Result := TRUE; + end; + {WM_PAINT, WM_PRINT, WM_NCPAINT: + begin + Rslt := 0; + Result := TRUE; + end;} + END; +end; + +{$IFNDEF TOGRUSH_NO_SCROLLBARS} +type PSBObj = ^TSBObj; + TSBObj = object( TObj ) + sbar: PControl; + orientation: TScrollerBar; + b_up, b_dn, thumb: PGRushControl; + minpos, maxpos, oldpos, curpos: Integer; + pagesz, linesz: Integer; + Timer: PTimer; + how_scroll_by_timer, cmd_timer: Integer; + th_click_mouse, th_delta: Integer; + th_click_curpos: Integer; + th_clicked: Boolean; + procedure Init; virtual; + destructor Destroy; virtual; + procedure Adjust; + procedure Resized( Sender: PObj ); + procedure UpClick( Sender: PControl; var Mouse: TMouseEventData ); + procedure DnClick( Sender: PControl; var Mouse: TMouseEventData ); + procedure ThumbClick( Sender: PControl; var Mouse: TMouseEventData ); + procedure ThumbTrack( Sender: PControl; var Mouse: TMouseEventData ); + procedure TimerOff( Sender: PControl; var Mouse: TMouseEventData ); + procedure Release_Capture( Sender: PControl; var Mouse: TMouseEventData ); + procedure Scrolled( cmd: Integer ); + procedure ScrollByTimer( Sender: PObj ); + function WndProc( var M: TMsg; var Rslt: Integer ): Boolean; + end; + +function WndProcScrollbar( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean; +var SBObj: PSBObj; +begin + SBObj := Pointer( Sender.CustomObj ); + Result := SBObj.WndProc( M, Rslt ); +end; + + function TriangleBitmap( const PtsVert, PtsHorz: array of Integer; Horizontal: Boolean ): PBitmap; + type TIntArray = array[0..100] of Integer; + PIntArray = ^TIntArray; + var Pts: PIntArray; + begin + Result := NewDIBBitmap( 8, 8, pf1bit ); + Result.DIBPalEntries[ 1 ] := $FFFFFF; + Result.Canvas.Brush.Color := clWhite; + Result.Canvas.FillRect( Result.BoundsRect ); + if Horizontal then Pts := Pointer( @ PtsHorz[ 0 ] ) + else Pts := Pointer( @ PtsVert[ 0 ] ); + Result.Canvas.Brush.Color := clBlack; + Result.Canvas.Polygon( [ MakePoint( Pts[0],Pts[1] ), + MakePoint( Pts[2],Pts[3] ), + MakePoint( Pts[4],Pts[5] ), + MakePoint( Pts[6],Pts[7] ) ] ); + end; + + function TriangleUpBitmap( Horizontal: Boolean ): PBitmap; + begin + Result := TriangleBitmap( [ 0,5, 3,2, 4,2, 7,5 ], + [ 5,0, 2,3, 2,4, 5,7 ], Horizontal ); + end; + + function TriangleDnBitmap( Horizontal: Boolean ): PBitmap; + begin + Result := TriangleBitmap( [ 0,2, 3,5, 4,5, 7,2 ], + [ 2,0, 5,3, 5,4, 2,7 ], Horizontal ); + end; + +function NewScrollBar( AParent: PControl; BarSide: TScrollerBar ): PControl; +var SBObj: PSBObj; + W, H: Integer; + Bup, Bdn, Bth: PBitmap; + R: TRect; + + procedure FillThumbBmp( x, y: Integer ); + var i, dx, dy: Integer; + begin + dx := 0; + dy := 0; + if BarSide = sbHorizontal then dx := 1 + else dy := 1; + for i := 1 to 4 do + begin + Bth.Canvas.MoveTo( x, y ); + Bth.Canvas.LineTo( x + dy * 8, y + dx * 8 ); + inc( x, dx * 2 ); + inc( y, dy * 2 ); + end; + end; + +var A: TControlAlign; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + begin + {Result := KOL.NewScrollBar(AParent, BarSide); + AParent.AttachProc( @ WndProc_RecolorScrollbars );} + W := GetSystemMetrics( SM_CXVSCROLL ); + H := GetSystemMetrics( SM_CYHSCROLL ); + Result := KOL.NewPanel( AParent, esNone ); + Result.Border := 0; + Result.Color := ColorsMix( clGRushLighten, clGRushLight ); + if BarSide = sbHorizontal then + Result.SetSize( 0, W ) + else + Result.SetSize( H, 0 ); + new( SBObj, Create ); + Result.CustomObj := SBObj; + SBObj.sbar := Result; + SBObj.orientation := BarSide; + SBObj.maxpos := 100; + SBObj.pagesz := 1; + SBObj.linesz := 1; + SBObj.b_up := NewGRushButton( Result, '' ); + A := caTop; if BarSide = sbHorizontal then A := caLeft; + SBObj.b_up.SetSize( W, H ).SetAlign( A ).LikeSpeedButton; + SBObj.b_dn := NewGRushButton( Result, '' ); + A := caBottom; if BarSide = sbHorizontal then A := caRight; + SBObj.b_dn.SetSize( W, H ).SetAlign( A ).LikeSpeedButton; + SBObj.thumb := NewGRushButton( Result, '' ); + SBObj.thumb.SetSize( W, H ).LikeSpeedButton; + Bup := TriangleUpBitmap( BarSide = sbHorizontal ); + Bdn := TriangleDnBitmap( BarSide = sbHorizontal ); + Bth := NewDIBBitmap( 10, 10, pf32bit ); + Bth.Canvas.Pen.Color := SBObj.b_up.Def_ColorFrom; + FillThumbBmp( 1, 1 ); + Bth.Canvas.Pen.Color := SBObj.b_up.Def_ColorTo; + FillThumbBmp( 2, 2 ); + + Result.OnResize := SBObj.Resized; + + SBObj.b_up.All_GlyphBitmap := Bup; Bup.Free; + SBObj.b_up.All_GlyphHAlign := haCenter; + SBObj.b_dn.All_GlyphBitmap := Bdn; Bdn.Free; + SBObj.b_dn.All_GlyphHAlign := haCenter; + SBObj.thumb.All_GlyphBitmap := Bth; Bth.Free; + SBObj.thumb.All_GlyphHAlign := haCenter; + //SBObj.thumb.All_ContentOffsets := MakeRect( -1, -1, 1, 1 ); + R := MakeRect( 1, 1, -1, -1 ); + SBObj.b_up.All_ContentOffsets := R; + SBObj.b_dn.All_ContentOffsets := R; + SBObj.thumb.All_ContentOffsets := R; + if BarSide = sbHorizontal then SBObj.thumb.Left := W + else SBObj.thumb.Top := H; + + SBObj.b_up.OnMouseDown := SBObj.UpClick; + SBObj.b_dn.OnMouseDown := SBObj.DnClick; + SBObj.thumb.OnMouseDown := SBObj.ThumbClick; + SBObj.b_up.OnMouseUp := SBObj.TimerOff; + SBObj.b_dn.OnMouseUp := SBObj.TimerOff; + SBObj.thumb.OnMouseUp := SBObj.Release_Capture; + SBObj.thumb.OnMouseMove := SBObj.ThumbTrack; + Result.AttachProc( WndProcScrollbar ); + SBObj.Timer := NewTimer( 400 ); + SBObj.Timer.OnTimer := SBObj.ScrollByTimer; + end + {$IFDEF TOGRUSH_OPTIONAL} + else Result := Kol.NewScrollBar( AParent, BarSide ) + {$ENDIF TOGRUSH_OPTIONAL} + ; +end; + +function Scrollbar_GetMinPos( sb: PControl ): Integer; +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGRush then + begin + Result := sb.SBMin; + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + Result := SBObj.minpos; +end; + +procedure Scrollbar_SetMinPos( sb: PControl; m: Integer ); +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGRush then + begin + sb.SBMin := m; + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + SBObj.minpos := m; + SBObj.Adjust; +end; + +procedure Scrollbar_SetAll( sb: PControl; min, max, pg, cur: Integer ); +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGRush then + begin + sb.SBMin := min; + sb.SBMax := max; + sb.SBPageSize := pg; + sb.SBPosition := cur; + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + SBObj.minpos := min; + SBObj.maxpos := max; + SBObj.pagesz := pg; + SBObj.curpos := cur; + SBObj.Adjust; +end; + +procedure Scrollbar_SetMaxPos( sb: PControl; m: Integer ); +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGRush then + begin + sb.SBMax := m; + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + SBObj.maxpos := m; + SBObj.Adjust; +end; + +function Scrollbar_GetMaxPos( sb: PControl ): Integer; +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Result := sb.SBMax; + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + Result := SBObj.maxpos; +end; + +function Scrollbar_GetCurPos( sb: PControl ): Integer; +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then + begin + Result := sb.SBPosition; + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + if SBObj <> nil then + Result := SBObj.curpos + else Result := 0; +end; + +procedure Scrollbar_SetCurPos( sb: PControl; newp: Integer ); +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGRush then + begin + sb.SBPosition := newp; + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + SBObj.curpos := newp; + SBObj.Adjust; +end; + +procedure Scrollbar_SetPageSz( sb: PControl; psz: Integer ); +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGRush then + begin + sb.SBPageSize := psz; + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + SBObj.pagesz := psz; + SBObj.Adjust; +end; + +function Scrollbar_GetPageSz( sb: PControl ): Integer; +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGRush then + begin + Result := sb.SBPageSize; + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + Result := SBObj.pagesz; +end; + +procedure Scrollbar_SetLineSz( sb: PControl; lnz: Integer ); +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGRush then + begin + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + SBObj.linesz := lnz; +end; + +function Scrollbar_GetLineSz( sb: PControl ): Integer; +var SBObj: PSBObj; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGRush then + begin + Result := 1; + Exit; + end; + {$ENDIF} + SBObj := Pointer( sb.CustomObj ); + Result := SBObj.linesz; +end; + +{ TSBObj } + +procedure TSBObj.Init; +begin + +end; + +destructor TSBObj.Destroy; +begin + Timer.Free; + inherited; +end; + +procedure TSBObj.Adjust; +var total_sz, side_sz, button_sz, thumb_sz, thumb_pos, min_thumb: Integer; + R: TRect; + + procedure ProvideWindow( ctl: PControl ); + begin + if {(ctl.Handle = 0) and} (ctl.Width > 0) and (ctl.Height > 0) then + begin + ctl.Visible := TRUE; + ctl.CreateWindow; + end + else + ctl.Visible := FALSE; + end; +begin + if orientation = sbHorizontal then + begin + total_sz := min( sbar.Width, sbar.Parent.Width ); + side_sz := min( sbar.Height, sbar.Parent.Height ); + end + else + begin + total_sz := min( sbar.Height, sbar.Parent.Height ); + side_sz := min( sbar.Width, sbar.Parent.Width ); + end; + min_thumb := Max( 4, Min( 8, side_sz ) ); + if total_sz - min_thumb >= 2 * side_sz then + begin + button_sz := side_sz; + dec( total_sz, 2 * side_sz ); + end + else + begin + button_sz := total_sz div 2; + total_sz := 0; + end; + if (total_sz > 8) and (maxpos > minpos) then + begin + if minpos < maxpos then + begin + thumb_sz := Round( pagesz * total_sz / + (maxpos - minpos + pagesz) ); + if (thumb_sz < side_sz) and + ((total_sz - side_sz) * 10 div (maxpos - minpos) > 1) then + thumb_sz := side_sz; + if thumb_sz < min_thumb then thumb_sz := min_thumb; + end + else + thumb_sz := side_sz; + if thumb_sz > total_sz then + thumb_sz := total_sz; + dec( total_sz, thumb_sz ); + end + else thumb_sz := 0; + if total_sz > 0 then + begin + if minpos < maxpos then + thumb_pos := (total_sz{-1}) * (curpos - minpos) div (maxpos - minpos) + else thumb_pos := 0; + end + else thumb_pos := 0; + if orientation = sbHorizontal then + begin + b_up.BoundsRect := MakeRect( 0, 0, button_sz, side_sz ); + b_dn.BoundsRect := MakeRect( sbar.Width - button_sz, 0, sbar.Width, side_sz ); + R := MakeRect( button_sz + thumb_pos, 0, + button_sz + thumb_pos + thumb_sz, side_sz ); + end + else + begin + b_up.BoundsRect := MakeRect( 0, 0, side_sz, button_sz ); + b_dn.BoundsRect := MakeRect( 0, sbar.Height - button_sz, side_sz, sbar.Height ); + R := MakeRect( 0, button_sz + thumb_pos, side_sz, + button_sz + thumb_pos + thumb_sz ); + end; + if not RectsEqual( R, thumb.BoundsRect ) then + begin + thumb.BoundsRect := R; + if Assigned( sbar.OnSBScroll ) then + sbar.OnSBScroll( sbar, SB_THUMBTRACK ); + end; + ProvideWindow( b_up ); + ProvideWindow( b_dn ); + ProvideWindow( thumb ); + sbar.Update; +end; + +procedure TSBObj.DnClick(Sender: PControl; var Mouse: TMouseEventData); +begin + how_scroll_by_timer := linesz; + cmd_timer := SB_LINERIGHT; + ScrollByTimer( nil ); + Timer.Interval := 400; + Timer.Enabled := TRUE; +end; + +procedure TSBObj.Release_Capture( Sender: PControl; var Mouse: TMouseEventData ); +begin + th_clicked := FALSE; + ReleaseCapture; +end; + +procedure TSBObj.Resized(Sender: PObj); +begin + Adjust; +end; + +procedure TSBObj.ScrollByTimer(Sender: PObj); +begin + oldpos := curpos; + inc( curpos, how_scroll_by_timer ); + if curpos < minpos then curpos := minpos; + if curpos > maxpos then curpos := maxpos; + Adjust; + Scrolled( cmd_timer ); + Timer.Interval := 100; +end; + +procedure TSBObj.Scrolled( cmd: Integer ); +var Allow: Boolean; +begin + Allow := TRUE; + if Assigned( sbar.OnSBBeforeScroll ) then + sbar.OnSBBeforeScroll( sbar, oldpos, curpos, cmd, Allow ); + if Assigned( sbar.OnSBScroll ) then + sbar.OnSBScroll( sbar, cmd ) + else + if Assigned( sbar.OnScroll ) then + sbar.OnScroll( sbar, orientation, cmd, curpos ); +end; + +procedure TSBObj.ThumbClick(Sender: PControl; var Mouse: TMouseEventData); +var P: TPoint; +begin + SetCapture( thumb.Handle ); + th_clicked := TRUE; + P := thumb.Client2Screen( MakePoint( Mouse.X, Mouse.Y ) ); + if orientation = sbHorizontal then + begin + th_click_mouse := P.X; + th_delta := -Mouse.X; + end + else + begin + th_click_mouse := P.Y; + th_delta := -Mouse.Y; + end; + th_click_curpos := curpos +end; + +procedure TSBObj.ThumbTrack(Sender: PControl; var Mouse: TMouseEventData); +var new_pos, new_top, total_sz, button_sz, thumb_sz: Integer; + P: TPoint; +begin + if not th_clicked then Exit; + oldpos := curpos; + P := Sender.Client2Screen( MakePoint( Mouse.X, Mouse.Y ) ); + P := sbar.Screen2Client(P); + if orientation = sbHorizontal then + begin + new_top := P.X; + button_sz := b_up.Width; + thumb_sz := thumb.Width; + total_sz := sbar.Width; + end + else + begin + new_top := P.Y; + button_sz := b_up.Height; + thumb_sz := thumb.Height; + total_sz := sbar.Height; + end; + new_top := new_top - button_sz + th_delta; + dec( total_sz, 2 * button_sz + thumb_sz ); + if total_sz > 0 then + new_pos := minpos + (maxpos - minpos) * new_top div total_sz + else + new_pos := 0; + if new_pos < minpos then new_pos := minpos; + if new_pos > maxpos then new_pos := maxpos; + curpos := new_pos; + Adjust; + Scrolled( SB_THUMBTRACK ); +end; + +procedure TSBObj.TimerOff(Sender: PControl; var Mouse: TMouseEventData); +begin + Timer.Enabled := FALSE; +end; + +procedure TSBObj.UpClick(Sender: PControl; var Mouse: TMouseEventData); +begin + how_scroll_by_timer := -linesz; + cmd_timer := SB_LINELEFT; + ScrollByTimer( nil ); + Timer.Interval := 400; + Timer.Enabled := TRUE; +end; + +function TSBObj.WndProc(var M: TMsg; var Rslt: Integer): Boolean; +var X, Y: Integer; + procedure CalcScrollDirAndStep; + begin + how_scroll_by_timer := 0; + if orientation = sbHorizontal then + begin + X := SmallInt( LoWord( M.lParam ) ); + if X < thumb.Left then + how_scroll_by_timer := -pagesz + else + if X > thumb.Left + thumb.Width then + how_scroll_by_timer := pagesz + else Exit; + end + else + begin + Y := SmallInt( HiWord( M.lParam ) ); + if Y < thumb.Top then + how_scroll_by_timer := -pagesz + else + if Y > thumb.Top + thumb.Height then + how_scroll_by_timer := pagesz + else Exit; + end; + + if how_scroll_by_timer < 0 then + cmd_timer := SB_PAGELEFT + else + cmd_timer := SB_PAGERIGHT; + end; +begin + Result := FALSE; + CASE M.message OF + WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: + begin + CalcScrollDirAndStep; + if (how_scroll_by_timer = 0) then Exit; + + SetCapture( sbar.Handle ); + ScrollByTimer( nil ); + Timer.Interval := 400; + Timer.Enabled := TRUE; + end; + WM_LBUTTONUP: + begin + ReleaseCapture; + Timer.Enabled := FALSE; + end; + WM_MOUSEMOVE: + begin + if (Timer <> nil) and Timer.Enabled then + CalcScrollDirAndStep; + end; + END; +end; + +type + POverrideScrollbars = ^TOverrideScrollbars; + TOverrideScrollbars = object( TObj ) + Handling: Boolean; + Added2List: Boolean; + VBar, HBar, Grip: PControl; + Control2Override: PControl; + procedure ReplacedScrollBar2Original( Sender: PControl; Cmd: Word ); + destructor Destroy; virtual; + procedure PaintGrip( Sender: PControl; DC: HDC ); + end; + +var ListOfOverridenSBars: PList; + +{ TOverrideScrollbars } + +destructor TOverrideScrollbars.Destroy; +begin + Control2Override.CustomObj := nil; //? + if Added2List then + begin + ListOfOverridenSBars.Remove( Control2Override ); + if ListOfOverridenSBars.Count = 0 then + begin + KillTimer( 0, ListOfOverridenSBars.Tag ); + Free_And_Nil( ListOfOverridenSBars ); + end; + end; + inherited; +end; + +procedure TOverrideScrollbars.PaintGrip(Sender: PControl; DC: HDC); +var R: TRect; + P: TPoint; + F: PControl; + i, j: Integer; + C: PCanvas; +begin + R := Sender.ClientRect; + C := Sender.Canvas; + C.FillRect( R ); + P := MakePoint( R.Right, R.Bottom ); + P := Sender.Client2Screen( P ); + F := Sender.ParentForm; + P := F.Screen2Client( P ); + if (F.ClientWidth - P.X < 16) and + (F.ClientHeight - P.Y < 16) then + begin + for j := 0 to 1 do + begin + C.Pen.Color := clWhite; + if j = 1 then + C.Pen.Color := clGRushDark; + for i := 0 to 4 do + begin + C.MoveTo( 2+j+i*3, R.Bottom-2 ); + C.LineTo( R.Right-2, 2+j+i*3 ); + end; + end; + end; +end; + +procedure TOverrideScrollbars.ReplacedScrollBar2Original(Sender: PControl; + Cmd: Word); +var O: POverrideScrollbars; + Ctl: PControl; + Msg: DWORD; + CmdF: DWORD; + Wnd: HWnd; +var SI: TScrollInfo; + Bar: Integer; + NewPos: Integer; + i, MaxI: Integer; + Frozen: Boolean; +begin + Ctl := Pointer( Sender.Tag ); + O := Pointer( Ctl.CustomObj ); + if O.HBar = Sender then Msg := WM_HSCROLL + else Msg := WM_VSCROLL; + {CASE Cmd OF + SB_LINEUP, + SB_LINEDOWN, + SB_THUMBTRACK: + Cmd := SB_THUMBPOSITION; + END;} + CmdF := Cmd; + NewPos := Scrollbar_GetCurPos( Sender ); + CASE Cmd OF + SB_THUMBTRACK, SB_THUMBPOSITION: + CmdF := Cmd or (NewPos shl 16); + END; + if not O.Handling then + begin + O.Handling := TRUE; + Frozen := FALSE; + TRY + Wnd := Ctl.Handle; + // В случае, если не удастся и значение останется прежним, то это + // контрол, который не понимает внешний WM_xSCROLL с SB_THUMBXXXX + // (ListView). Тогда пробуем откорректировать позию его скроллбара + // последовательными командами SB_LINEUP / SB_LINEDOWN + i := 0; + MaxI := 10; + while i < MaxI do + begin + inc( i ); + SI.cbSize := Sizeof( SI ); + SI.fMask := SIF_PAGE or SIF_POS or SIF_RANGE or SIF_TRACKPOS; + if O.HBar = Sender then Bar := SB_HORZ + else Bar := SB_VERT; + GetScrollInfo( Wnd, Bar, SI ); + MaxI := max( MaxI, DWORD(SI.nMax - SI.nMin) div (SI.nPage + 1) ); + if (SI.nPos = NewPos) or + (SI.nPos < NewPos) and (CmdF = SB_LINEUP) or + (SI.nPos > NewPos) and (CmdF = SB_LINEDOWN) then break; + SendMessage( Wnd, Msg, CmdF, 0 ); + if SI.nPos < NewPos then CmdF := SB_LINEDOWN + else CmdF := SB_LINEUP; + if DWORD( Abs( SI.nPos - NewPos ) ) > SI.nPage then + begin + if SI.nPos < NewPos then CmdF := SB_PAGEDOWN + else CmdF := SB_PAGEUP; + if not Frozen then + begin + Ctl.BeginUpdate; + Frozen := TRUE; + end; + end + else + if Frozen then + begin + Frozen := FALSE; + Ctl.EndUpdate; + end; + end; + FINALLY + O.Handling := FALSE; + if Frozen then + Ctl.EndUpdate; + END; + end; +end; + +procedure WindowScrollbar2GrushScrollbar( Ctl: PControl; SBar: PControl; Bar: DWORD ); +var SI: TScrollInfo; + Wnd: HWnd; +begin + SI.cbSize := Sizeof( SI ); + SI.fMask := SIF_PAGE or SIF_POS or SIF_RANGE or SIF_TRACKPOS; + Wnd := Ctl.Handle; + GetScrollInfo( Wnd, Bar, SI ); + Scrollbar_SetAll( SBar, SI.nMin, SI.nMax - Integer( SI.nPage ) + 1, + SI.nPage, SI.nPos ); +end; + +procedure CheckOverridenSBars( wnd: HWnd; msg, event, time: DWORD ); stdcall; +var i: Integer; + Control2Override: PControl; +begin + if ListOfOverridenSBars = nil then Exit; + for i := 0 to ListOfOverridenSBars.Count-1 do + begin + Control2Override := ListOfOverridenSBars.Items[ i ]; + Control2Override.Perform( CM_AUTOSIZE, 0, 0 ); + end; +end; + +type TGetScrollbarInfo = function( Wnd: HWnd; Obj: Integer; var Info: TScrollBarInfo ): BOOL; + stdcall; +var GetScrollbarInfo: TGetScrollbarInfo; + +function WndProcOverrideScrollbars( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean; +var O: POverrideScrollbars; + HasHBar, HasVBar: Boolean; + + function CreateScrollbarReplacement( Ctl: PControl; Direction: TScrollerBar; + Flag: DWORD; var SBar: PControl ): Boolean; + var SBI: TScrollBarInfo; + R: TRect; + ParentWnd: Hwnd; + Wnd: HWnd; + //M: TMsg; + SBarCtl: PControl; + wasSBarVisible: Boolean; + E: Boolean; + M: THandle; + begin + Result := FALSE; + SBI.cbSize := Sizeof( SBI ); + Wnd := Ctl.Handle; + if not Assigned( GetScrollbarInfo ) then + begin + M := GetModuleHandle( 'user32' ); + GetScrollbarInfo := GetProcAddress( M, 'GetScrollBarInfo' ); + end; + if GetScrollbarInfo( Wnd, Integer( Flag ), SBI ) and + (SBI.rcScrollBar.Bottom > 0) and + (SBI.rcScrollBar.Right > 0) then + begin + if not IsWindowVisible( Wnd ) or + (SBI.rgstate[0] and STATE_SYSTEM_INVISIBLE <> 0) then + begin + {if not PeekMessage( M, Ctl.Handle, CM_AUTOSIZE, CM_AUTOSIZE, pm_noremove ) + and (SBar = nil) then + Ctl.Postmsg( WM_USER+1, 0, 0 );} + end + else + begin + E := not( (SBI.rgstate[1] and STATE_SYSTEM_UNAVAILABLE <> 0) and + (SBI.rgstate[5] and STATE_SYSTEM_UNAVAILABLE <> 0) ); + + if (SBI.rcScrollBar.Left < SBI.rcScrollBar.Right) and + (SBI.rcScrollBar.Top < SBI.rcScrollBar.Bottom) then + begin + Result := TRUE; + if Wnd = Ctl.Handle then ParentWnd := Ctl.Parent.Handle + else begin + ParentWnd := Wnd; //GetWindow( Wnd, GW_OWNER ); + SetWindowLong( Wnd, GWL_STYLE, + GetWindowLong( Wnd, GWL_STYLE ) + or WS_CLIPCHILDREN ); + end; + + if SBar = nil then + begin + SBar := NewScrollBar( Ctl.Parent, Direction ); + if Wnd <> Ctl.Handle then + SetParent( SBar.Handle, ParentWnd ); + SBar.Tag := DWORD( Ctl ); + SBar.OnSBScroll := O.ReplacedScrollBar2Original; + end; + SBarCtl := SBar; + SBarCtl.RefInc; + TRY + R := SBI.rcScrollBar; + Windows.ScreenToClient( ParentWnd, R.TopLeft ); + Windows.ScreenToClient( ParentWnd, R.BottomRight ); + if not RectsEqual( SBarCtl.BoundsRect, R ) then + SBarCtl.BoundsRect := R; + if SBar <> nil then + begin + if Wnd = Ctl.Handle then SBarCtl.BringToFront + else begin + SBarCtl.Visible := TRUE; + SBarCtl.StayOnTop := TRUE; + SBarCtl.BringToFront; + end; + end; + if E <> SBarCtl.Enabled then + begin + SBarCtl.Enabled := E; + SBarCtl.EnableChildren( E, FALSE ); + end; + FINALLY + SBarCtl.RefDec; + END; + end; + end; + end; + if not Result and (SBar <> nil) then + begin + wasSBarVisible := SBar.Visible; + SBar.Visible := FALSE; + if wasSBarVisible then + Ctl.Invalidate; + //Free_And_Nil( SBar ); + end; + end; + +var TimerHandle: DWORD; + R1, R2, RGrip: TRect; +begin + Result := FALSE; + CASE M.message OF + WM_NCPAINT: // нельзя обрабатывать непосредственно: портится участок + // изображения не-клиентской части (на пересечении скроллов, в + // нижнем правом углу) + Sender.Postmsg( CM_AUTOSIZE, 0, 0 ); + WM_SIZE, WM_VSCROLL, WM_HSCROLL, WM_WINDOWPOSCHANGING, WM_WINDOWPOSCHANGED, + WM_PAINT, CM_AUTOSIZE + //, WM_MOUSEWHEEL, WM_LBUTTONUP, WM_KEYUP, WM_SYSKEYUP + : + if Sender.ToBeVisible then + begin + O := Pointer( Sender.CustomObj ); + if not O.Handling then + begin + O.Handling := TRUE; + TRY + HasHBar := CreateScrollbarReplacement( Sender, + sbHorizontal, OBJID_HSCROLL, O.HBar ); + HasVBar := CreateScrollbarReplacement( Sender, + sbVertical, OBJID_VSCROLL, O.VBar ); + + if HasHBar then + WindowScrollbar2GrushScrollbar( Sender, + O.HBar, SB_HORZ ); + if HasVBar then + WindowScrollbar2GrushScrollbar( Sender, + O.VBar, SB_VERT ); + + if HasHBar or HasVBar then + begin + if not O.Added2List then + begin + if ListOfOverridenSBars = nil then + begin + ListOfOverridenSBars := NewList; + TimerHandle := SetTimer( 0, 0, 250, @CheckOverridenSBars ); + ListOfOverridenSBars.Tag := DWORD( TimerHandle ); + end; + ListOfOverridenSBars.Add( O.Control2Override ); + O.Added2List := TRUE; + end; + end; + + if HasHBar and HasVBar then + begin + R1 := O.HBar.BoundsRect; + R2 := O.VBar.BoundsRect; + RGrip := MakeRect( R2.Left, R1.Top, R2.Right, R1.Bottom ); + end + else + RGrip := MakeRect( 0, 0, 0, 0 ); + if (RGrip.Left < RGrip.Right) and + (RGrip.Top < RGrip.Bottom) then + begin + if O.Grip = nil then + O.Grip := NewPaintbox( Sender.Parent ).MouseTransparent; + O.Grip.Color := Sender.Parent.Color; + O.Grip.BoundsRect := RGrip; + O.Grip.OnPaint := O.PaintGrip; + O.Grip.BringToFront; + end + else + begin + if O.Grip <> nil then + O.Grip.Visible := FALSE; + end; + FINALLY + O.Handling := FALSE; + END; + end; + end; + END; +end; + +procedure OverrideScrollbars( C: PControl ); +var O: POverrideScrollbars; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if NoGrush then Exit; + {$ENDIF} + new( O, Create ); O.Control2Override := C; + C.CustomObj := O; + C.AttachProc( WndProcOverrideScrollbars ); +end; + +{$ENDIF TOGRUSH_NO_SCROLLBARS} + +//////////////////////////////////////////////////////////////////////////////// +// COMBO BOX +//////////////////////////////////////////////////////////////////////////////// +type + PFixComboButton = ^TFixComboButton; + TFixComboButton = object( TObj ) + Fixed: Boolean; + Button: PControl; + Combo: PControl; + Form, LB: PControl; + SzIncrease, TargetSz: Integer; + TimerAnimation: PTimer; + ClosedTime: DWORD; + procedure DoDropDownList; + procedure LBData( Sender: PControl; Idx, SubItem: Integer; + var Txt: KOL_String; var ImgIdx: Integer; var State: DWORD; + var Store: Boolean ); + procedure SelectItemUnderCursor( Sender: PControl; var Mouse: TMouseEventData ); + procedure KeyPressed( Sender: PControl; var Key: KOLChar; Shift: DWORD ); + procedure CloseDropDown( SelectOK: Boolean ); + procedure SelectItemByMouse( Sender: PControl; var Mouse: TMouseEventData ); + procedure SelectItemByMouse2( Sender: PControl; var Mouse: TMouseEventData ); + procedure AnimateDropDown( Sender: PObj ); + function Deactivation( var M: TMsg; var Rslt: Integer ): Boolean; + end; + +{ TFixComboButton } + +procedure TFixComboButton.LBData(Sender: PControl; Idx, SubItem: Integer; + var Txt: KOL_String; var ImgIdx: Integer; var State: DWORD; + var Store: Boolean); +begin + Txt := Combo.Items[ Idx ]; +end; + +procedure TFixComboButton.SelectItemUnderCursor(Sender: PControl; + var Mouse: TMouseEventData); +var i: Integer; + P: TPoint; +begin + if Form = nil then Exit; + P := MakePoint( Mouse.X, Mouse.Y ); + P := Form.Client2Screen( P ); + P := LB.Screen2Client( P ); + i := LB.LVItemAtPos( Mouse.X, Mouse.Y ); + if i >= 0 then + LB.LVCurItem := i; +end; + +procedure TFixComboButton.KeyPressed(Sender: PControl; var Key: KOLChar; + Shift: DWORD); +begin + CASE Key OF + #13: if LB.LVCurItem >= 0 then CloseDropDown( TRUE ); + #27: CloseDropDown( FALSE ); + END; +end; + +procedure TFixComboButton.SelectItemByMouse(Sender: PControl; + var Mouse: TMouseEventData); +var i: Integer; + P: TPoint; +begin + P := MakePoint( Mouse.X, Mouse.Y ); + P := Form.Client2Screen( P ); + P := LB.Screen2Client( P ); + i := LB.LVItemAtPos( P.X, P.Y ); + if i >= 0 then + LB.LVCurItem := i; + {if Mouse.Button = mbLeft then + SetCapture( Form.Handle );} + {if Mouse.Button = mbLeft then + if i >= 0 then CloseDropDown( TRUE );} +end; + +procedure TFixComboButton.SelectItemByMouse2(Sender: PControl; + var Mouse: TMouseEventData); +var i: Integer; + P: TPoint; +begin + P := MakePoint( Mouse.X, Mouse.Y ); + P := Form.Client2Screen( P ); + P := LB.Screen2Client( P ); + i := LB.LVItemAtPos( P.X, P.Y ); + if i >= 0 then + LB.LVCurItem := i; + if Mouse.Button = mbLeft then + if i >= 0 then CloseDropDown( TRUE ); +end; + +procedure TFixComboButton.CloseDropDown(SelectOK: Boolean); +var i: Integer; + F: PControl; +begin + if TimerAnimation = nil then Exit; + TimerAnimation.Enabled := FALSE; + ClosedTime := GetTickCount; + i := LB.LVCurItem; + if SelectOK then Combo.CurIndex := i; + Free_And_Nil( TimerAnimation ); + F := Form; + Form := nil; + LB := nil; + F.Close; + Combo.Focused := TRUE; + Applet.ActiveControl := Combo.ParentForm; + if SelectOK and Assigned( Combo.OnSelChange ) then + Combo.OnSelChange( Combo ); +end; + +function TFixComboButton.Deactivation(var M: TMsg; var Rslt: Integer): Boolean; +begin + Result := FALSE; + if M.message = WM_KILLFOCUS then + begin + CloseDropDown( FALSE ); + end; +end; + +procedure TFixComboButton.DoDropDownList; +var R: TRect; + n, h: Integer; +begin + if Assigned( Combo.OnDropDown ) then + Combo.OnDropDown( Combo ); + R := Combo.BoundsRect; + if Combo.DroppedWidth > 0 then + R.Right := R.Left + Combo.DroppedWidth; + Windows.ClientToScreen( Combo.ParentWindow, R.TopLeft ); + Windows.ClientToScreen( Combo.ParentWindow, R.BottomRight ); + {$IFDEF USE_DROPDOWNCOUNT} + n := Combo.DropDownCount; + {$ELSE} + n := 8; + {$ENDIF} + if n > Combo.Count then n := Combo.Count; + if n < 1 then n := 1; + + Form := NewForm( Applet, '' ).SetSize( R.Right - R.Left, 1 ); + h := Combo.Font.FontHeight; + if h = 0 then h := 16; + TargetSz := n * (h+1); + SzIncrease := Max( 6, TargetSz div 5 ); + if ScreenHeight - R.Bottom < n * (h + 1) then + begin + SzIncrease := -SzIncrease; + Form.SetPosition( R.Left, R.Top-1 ); + end + else + Form.SetPosition( R.Left, R.Bottom ); + Form.HasBorder := FALSE; + Form.Border := 0; + LB := NewListView( Form, lvsDetailNoHeader, [ lvoRowSelect, lvoInfoTip, lvoOwnerData ], nil, nil, nil ) + .SetAlign( caClient ); + LB.Ctl3D := False; + LB.Color := Combo.Color; + LB.Font.Assign( Combo.Font ); + LB.LVColAdd( '', taLeft, R.Right - R.Left - 4 ); + LB.OnLVData := LBData; + LB.MouseTransparent; + Form.OnMouseMove := SelectItemUnderCursor; + LB.OnKeyChar := KeyPressed; + Form.OnMouseDown := SelectItemByMouse; + Form.OnMouseUp := SelectItemByMouse2; + LB.LVCount := max( 1, Combo.Count ); + LB.OnMessage := Deactivation; + OverrideScrollbars( LB ); + TimerAnimation := NewTimer( 20 ); + TimerAnimation.OnTimer := AnimateDropDown; + TimerAnimation.Enabled := TRUE; + Form.StayOnTop := TRUE; + Form.Show; + n := Combo.CurIndex; + if n >= 0 then + LB.LVMakeVisible( n, FALSE ); +end; + +procedure TFixComboButton.AnimateDropDown(Sender: PObj); +var BR: TRect; +begin + BR := Form.BoundsRect; + if SzIncrease < 0 then + inc( BR.Top, SzIncrease ) + else + inc( BR.Bottom, SzIncrease ); + if BR.Bottom - BR.Top > TargetSz+2 then + if SzIncrease < 0 then + BR.Top := Br.Bottom - TargetSz-2 + else + BR.Bottom := Br.Top + TargetSz+2; + if not RectsEqual( Form.BoundsRect, BR ) then + Form.BoundsRect := BR + else + TimerAnimation.Enabled := FALSE; +end; + +procedure ClickDropDownCombo( _Self, Sender: PControl ); +{$IFNDEF TOGRUSH_NO_WINDOW_SCROLLBARS} +var F: PFixComboButton; +{$ENDIF} +begin + {$IFDEF TOGRUSH_NO_WINDOW_SCROLLBARS} + _Self.Perform( CB_SHOWDROPDOWN, 1 - _Self.Perform( CB_GETDROPPEDSTATE, 0, 0 ), 0 ); + {$ELSE} + F := Pointer( _Self.CustomObj ); + if GetTickCount - F.ClosedTime > 200 then + begin + F.Combo := _Self; + F.DoDropDownList; + end; + {$ENDIF} +end; + +function WndProcComboToGRush( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean; +var wnd: HWnd; + R: TRect; + C2: PControl; + Bdn: PBitmap; + F: PFixComboButton; +begin + Result := FALSE; + CASE M.message OF + WM_SIZE: + begin + F := Pointer( Sender.CustomObj ); + if not F.Fixed then + begin + wnd := Sender.Handle; + if wnd <> 0 then + begin + wnd := GetWindow( wnd, GW_CHILD ); + if wnd <> 0 then + SetWindowLong( wnd, GWL_EXSTYLE, + GetWindowLong( wnd, GWL_EXSTYLE ) and not WS_EX_CLIENTEDGE ); + + Sender.MarginTop := 1; + Sender.MarginLeft := 1; + Sender.MarginRight := 1; + Sender.MarginBottom := 1; + C2 := NewGRushButton( Sender, '' ).LikeSpeedButton //.SetAlign( caRight ) + .SetSize( 18, 0 ); + Bdn := TriangleDnBitmap( FALSE ); + PGrushControl( C2 ).All_GlyphBitmap := Bdn; + PGrushControl( C2 ).All_GlyphHAlign := haCenter; + Bdn.Free; + C2.OnClick := TOnEvent( MakeMethod( Sender, @ClickDropDownCombo ) ); + C2.BringToFront; + Sender.Invalidate; + F.Button := C2; + F.Fixed := TRUE; + end; + end; + if F.Fixed then + begin + C2 := F.Button; + C2.BringToFront; + R := Sender.ClientRect; + R.Left := R.Right - 18; + C2.BoundsRect := R; + end; + end; + END; +end; + +{$IFNDEF TOGRUSH_NO_COMBO_EDIT} +function NewComboBox( AParent: PControl; Options: TComboOptions ): PControl; +var F: PFixComboButton; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + begin + Result := Kol.NewComboBox( AParent, Options ); + new( F, Create ); Result.CustomObj := F; + Result.AttachProc( WndProcComboToGRush ); + end + {$IFDEF TOGRUSH_OPTIONAL} + else Result := Kol.NewComboBox( AParent, Options ) + {$ENDIF TOGRUSH_OPTIONAL} + ; +end; +{$ENDIF} + +//////////////////////////////////////////////////////////////////////////////// +// EDIT BOX +//////////////////////////////////////////////////////////////////////////////// + +{$IFNDEF TOGRUSH_NO_COMBO_EDIT} +function NewEditBox( AParent: PControl; Options: TEditOptions ): PControl; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + begin + Result := Kol.NewEditBox( AParent, Options ); + Result.Ctl3D := FALSE; + end + {$IFDEF TOGRUSH_OPTIONAL} + else Result := Kol.NewEditBox( AParent, Options ) + {$ENDIF TOGRUSH_OPTIONAL} + ; +end; +{$ENDIF} + +{$IFNDEF TOGRUSH_NO_GRADIENTPANEL} +function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl; +var G: PGRushControl; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + begin + G := NewGRushPanel( AParent ); + Result := PControl( G ); + G.Def_ColorFrom := Color1; + G.Def_ColorTo := Color2; + G.Def_BorderWidth := 0; + G.Def_BorderRoundWidth := 0; + G.Def_BorderRoundHeight := 0; + end + {$IFDEF TOGRUSH_OPTIONAL} + else Result := Kol.NewGradientPanel( AParent, Color1, Color2 ); + {$ENDIF TOGRUSH_OPTIONAL} + ; +end; + +function NewGradientPanelEx( AParent: PControl; Color1, Color2: TColor; + Style: TGradientStyle; Layout: TGradientLayout ): PControl; +var G: PGRushControl; +begin + {$IFDEF TOGRUSH_OPTIONAL} + if not NoGrush then + {$ENDIF TOGRUSH_OPTIONAL} + begin + G := NewGRushPanel( AParent ); + Result := PControl( G ); + G.Def_ColorFrom := Color1; + G.Def_ColorTo := Color2; + G.Def_BorderWidth := 0; + G.Def_BorderRoundWidth := 0; + G.Def_BorderRoundHeight := 0; + CASE Layout OF + glTopLeft : G.Def_GradientStyle := gsFromTopLeft; + glTop : G.Def_GradientStyle := gsVertical; + glTopRight: G.Def_GradientStyle := gsFromTopRight; + glLeft : G.Def_GradientStyle := gsHorizontal; + glCenter : G.Def_GradientStyle := gsDoubleVert; + glRight : begin + G.Def_ColorFrom := Color2; + G.Def_ColorTo := Color1; + G.Def_GradientStyle := gsHorizontal; + end; + glBottomLeft: begin + G.Def_ColorFrom := Color2; + G.Def_ColorTo := Color1; + G.Def_GradientStyle := gsFromTopRight; + end; + glBottom : begin + G.Def_ColorFrom := Color2; + G.Def_ColorTo := Color1; + G.Def_GradientStyle := gsVertical; + end; + glBottomRight: + begin + G.Def_ColorFrom := Color2; + G.Def_ColorTo := Color1; + G.Def_GradientStyle := gsFromTopRight; + end; + END; + end + {$IFDEF TOGRUSH_OPTIONAL} + else Result := Kol.NewGradientPanelEx( AParent, Color1, Color2, Style, + Layout ); + {$ENDIF TOGRUSH_OPTIONAL} + ; +end; +{$ENDIF} + +function FindMenuItemByID( Menu: PMenu; ID: DWORD; var MaxTabulation: Integer ): PMenu; +var i, j, t: Integer; +begin + Result := nil; + for j := 0 to Menu.Count-1 do + begin + if Menu.ItemHandle[ j ] = ID then + begin + Result := Menu.Items[ j ]; + break; + end; + if Menu.Count > 0 then + begin + Result := FindMenuItemByID( Menu.Items[ j ], ID, MaxTabulation ); + if Result <> nil then break; + end; + end; + if Result <> nil then + begin + MaxTabulation := 6; + Menu := Result.Parent; + for i := 0 to Menu.Count-1 do + begin + t := pos( #9, Menu.ItemText[ i ] ); + if t > MaxTabulation then MaxTabulation := t; + end; + end; +end; + +var Menubmp: PBitmap; +function OwnerDrawMenuItem( var Msg: TMsg; const Menus: array of PMenu; + var Rslt: Integer): Boolean; +var Menu, Item: PMenu; + i, w1, y, m: Integer; + DC: HDC; + Sav: DWORD; + IsCheckItem: Boolean; + R: TRect; + MaxTabulation: Integer; + C: PCanvas; + s: KOLString; + Cside: Integer; + B_Color: TColor; + DI: PDrawItemStruct; + MI: PMeasureItemStruct; + ell: Integer; + + procedure SetupCanvasFont; + begin + C := Menubmp.Canvas; + C.Font.FontName := 'Arial'; + C.Font.FontHeight := Max( 6, GetSystemMetrics( SM_CYMENU ) - 4 ); + C.Font.FontStyle := [ fsBold ]; + C.Font.Color := MenuTextColor; + end; +begin + Result := FALSE; + if (Msg.message = WM_DRAWITEM) and (Msg.wParam = 0) then + begin + DI := Pointer( Msg.lParam ); + Item := nil; + // выбор меню + for m := 0 to High( Menus ) do + begin + Menu := Menus[ m ]; + Item := FindMenuItemByID( Menu, DI.itemID, MaxTabulation ); + if Item <> nil then break; + end; + if Item = nil then Exit; + IsCheckItem := Item.IsCheckItem; + // выбор цветов + R := DI.rcItem; + OffsetRect( R, -R.Left, -R.Top ); + DC := DI.hDC; + Sav := SaveDC( DC ); + // подготовка изображения + if (Menubmp <> nil) and ( + (Menubmp.Width < R.Right) or + (Menubmp.Height < R.Bottom) + ) then Free_And_Nil( Menubmp ); + Menubmp := NewDibBitmap( R.Right, R.Bottom, pf32bit ); + + SetupCanvasFont; + C.Font.Color := MenuTextColor; + if not Item.Enabled then + C.Font.Color := MenuTextDisabled; + {if WinVer < wvXP then} C.Font.FontQuality := fqAntialiased + {else C.Font.FontQuality := fqClearType}; + + if DI.itemState and ODS_SELECTED <> 0 then + begin + C.Brush.Color := MenuHighlight; + C.Font.Color := MenuTextHighlight; + if not Item.Enabled then + begin + C.Font.Color := MenuTextDisabSel; + C.Brush.Color := ColorsMix( C.Brush.Color, clSilver ); + end; + end + else + C.Brush.Color := MenuBackground; + B_Color := C.Brush.Color; + + C.FillRect( R ); + Cside := R.Bottom - 4; + if IsCheckItem then + begin // чек-бокс + C.Pen.Color := MenuCheckBoxBorder; + C.Pen.PenWidth := 1; + C.Brush.Color := MenuCheckBoxBkColor; + {$IFDEF ROUND_RADIOITEMS} + if Item.RadioGroup <> 0 then + C.Ellipse( 2, 2, Cside+2, Cside+2 ) + else + {$ENDIF ROUND_RADIOITEMS} + begin + C.FillRect( MakeRect( 2, 2, Cside+2, Cside+2 ) ); + C.Brush.Color := MenuCheckBoxBorder; + C.FrameRect( MakeRect( 2, 2, Cside+2, Cside+2 ) ); + end; + if Item.Checked then + begin + {$IFDEF ROUND_RADIOITEMS} + if Item.RadioGroup <> 0 then + begin + C.Pen.Color := MenuCheckBoxCheck; + C.Brush.Color := MenucheckBoxCheck; + ell := Max( 2, Min( Cside div 4, Cside-4 ) ); + C.Ellipse( 2+ell, 2+ell, Cside+2-ell, Cside+2-ell ); + end + else + {$ENDIF ROUND_RADIOITEMS} + begin + C.Pen.Color := MenuCheckBoxCheck; + C.Pen.PenWidth := 2; + C.MoveTo( 2 + 1, 2 + Cside div 2 ); + C.LineTo( 2 + Cside div 2, 2 + Cside - 2 ); + C.LineTo( 2 + Cside - 1, 3 ); + end; + end; + end; + + C.Brush.Color := B_Color; + + s := Item.Caption; + if s = '' then + begin + C.Brush.Color := MenuLine1Color; + y := R.Bottom div 2; + C.FillRect( MakeRect( 2, y, R.Right-2, y + 1 ) ); + C.Brush.Color := MenuLine2Color; + C.FillRect( MakeRect( 2, y+1, R.Right-2, y+2 ) ); + end + else + begin + s := Parse( s, #9 ); + C.RequiredState( HandleValid or FONTVALID or BrushValid or ChangingCanvas ); + R.Left := Cside + 4; + R.Top := 1; + DrawTextEx( C.Handle, PKOLChar( s ), Length( s ), + R, DT_LEFT or DT_SINGLELINE {$IFDEF RED_ACCELERATORS} or DT_HIDEPREFIX {$ENDIF}, nil ); + {$IFDEF RED_ACCELERATORS} + i := pos( '&', s ); + if i > 0 then + begin + w1 := C.TextWidth( Copy( s, 1, i-1 ) ); + C.DeselectHandles; + C.Font.Color := MenuAccelColor; + if not Item.Enabled then + C.Font.Color := //ColorsMix( C.Font.Color, clSilver ); + MenuAccelDisabled; + if DI.itemState and ODS_SELECTED <> 0 then + begin + C.Font.Color := MenuAccelSelColor; + if not Item.Enabled then + C.Font.Color := //ColorsMix( C.Font.Color, clSilver ); + MenuAccelSelDisabled; + end; + C.TextOut( R.Left + w1, R.Top, Copy( s, i+1, 1 ) ); + end; + {$ENDIF RED_ACCELERATORS} + {if s <> '' then w1 := C.TextWidth( 'Abcw' ) div 4 + else} w1 := 10; + s := Item.Caption; + Parse( s, #9 ); + if s <> '' then + begin + C.Font.Color := MenuHotKeyTextColor; + if not Item.Enabled then + C.Font.Color := //ColorsMix( C.Font.Color, clSilver ); + MenuHotKeyTxDisabled; + if DI.itemState and ODS_SELECTED <> 0 then + begin + C.Font.Color := MenuHotKeySelTxColor; + if not Item.Enabled then + C.Font.Color := //ColorsMix( C.Font.Color, clSilver ); + MenuHotKeySelTxDisabled; + end; + C.Brush.BrushStyle := bsClear; + C.TextOut( (Cside + 4) + w1 * MaxTabulation, 1, s ); + C.Brush.BrushStyle := bsSolid; + end; + end; + //Menubmp.SaveToFile( GetStartDir + 'test_custom_menu.bmp' ); + R := DI.rcItem; + //C.DeselectHandles; + RestoreDC( DC, Sav ); + BitBlt( DC, R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, + Menubmp.Canvas.Handle, 0, 0, SRCCOPY ); + //SetBkColor( DC, clGRushNormal ); + + //Result := TRUE; + Rslt := 1; + end + else + if Msg.message = WM_MEASUREITEM then + begin + MI := Pointer( Msg.lParam ); + if MI.CtlType <> ODT_MENU then Exit; + //Result := FALSE; + Item := nil; + // выбор меню + for i := 0 to High( Menus ) do + begin + Menu := Menus[ i ]; + // выбор элемента + Item := FindMenuItemByID( Menu, MI.itemID, MaxTabulation ); + if Item <> nil then break; + end; + if Item = nil then Exit; + // Вычисление размера элемента + if Menubmp = nil then + Menubmp := NewDibBitmap( 1, 1, pf32bit ); + SetupCanvasFont; + s := Item.Caption; + s := Parse( s, #9 ); + w1 := 10; + if s <> '' then + w1 := max( C.TextWidth(s), MaxTabulation * w1 ) + else + w1 := max( MaxTabulation, 8 ) * w1; + s := Item.Caption; + Parse( s, #9 ); + if Item.Caption <> '' then + MI.itemWidth := 20 + w1 + C.TextWidth(s) + else + MI.itemWidth := 20 + w1; + + if Item.Caption <> '' then + MI.ItemHeight := Menubmp.Canvas.TextHeight( Item.Caption )+2 + else + MI.itemHeight := 6; + + Result := TRUE; + Rslt := 1; + end; +end; + +initialization + KOL.OverrideScrollbars := OverrideScrollbars; + +finalization + + Free_And_Nil( DrDownBmp ); + {$IFNDEF TOGRUSH_NO_SCROLLBARS} + if SBBrush <> 0 then + DeleteObject( SBBrush ); + {$ENDIF} + Free_And_Nil( Menubmp ); + end. diff --git a/Addons/XPMenus.pas b/Addons/XPMenus.pas index e58b06b..bb961b4 100644 --- a/Addons/XPMenus.pas +++ b/Addons/XPMenus.pas @@ -142,7 +142,7 @@ begin Result.FOnMenuItem := aOnMenuItem; if (High(Template)>=0) and (Template[0] <> nil) then begin - if (AParent <> nil) and (PXPControl( AParent).fMenuObj = nil) and not PXPControl( AParent).fIsControl then + if (AParent <> nil) and (PXPControl( AParent).fMenuObj = nil) and not PXPControl( AParent).IsControl then Result.FHandle := CreateMenu else Result.FHandle := CreatePopupMenu; @@ -161,7 +161,7 @@ begin end else begin - if not PXPControl( AParent).fIsControl then + if not PXPControl( AParent).IsControl then begin {$IFDEF INITIALFORMSIZE_FIXMENU} R := AParent.ClientRect; diff --git a/Addons/addons_D2006.dpk b/Addons/addons_D2006.dpk index ae9078b..f15d47c 100644 --- a/Addons/addons_D2006.dpk +++ b/Addons/addons_D2006.dpk @@ -1,6 +1,6 @@ package addons_D2006; -{$R addons.res} +{$R 'addons.res'} {$R 'mckCCtrls.dcr'} {$R 'mckHTTPDownload.dcr'} {$R 'mckQProgBar.dcr'} @@ -84,6 +84,7 @@ contains tinyPNG in 'tinyPNG.pas', tinyJPGGIFBMP in 'tinyJPGGIFBMP.pas', mckWebBrowser in 'mckWebBrowser.pas', - mckDHTML in 'mckDHTML.pas'; + mckDHTML in 'mckDHTML.pas', + KolZLibBzip in 'KolZLibBzip.pas'; end. diff --git a/Addons/addons_D2010.dpk b/Addons/addons_D2010.dpk index 60ad630..ecf8c1d 100644 --- a/Addons/addons_D2010.dpk +++ b/Addons/addons_D2010.dpk @@ -1,6 +1,5 @@ package addons_D2010; -{$R *.res} {$R 'addons.res'} {$R 'mckCCtrls.dcr'} {$R 'mckHTTPDownload.dcr'} @@ -42,17 +41,26 @@ requires designide; contains + KOLCCtrls in 'KOLCCtrls.pas', + mckCCtrls in 'mckCCtrls.pas', KOLHashs in 'KOLHashs.PAS', mckHashs in 'mckHashs.pas', KOLFontEditor in 'KOLFontEditor.pas', KOLmhxp in 'KOLmhxp.pas', MCKMHXP in 'MCKMHXP.pas', + mckTCPSocket in 'mckTCPSocket.pas', + mckSocket in 'mckSocket.pas', mckListEdit in 'mckListEdit.pas', + KOLSocket in 'KOLSocket.pas', Objects in 'Objects.pas', + kolTCPSocket in 'kolTCPSocket.pas', mckCProgBar in 'mckCProgBar.pas', mckRarInfoBar in 'mckRarInfoBar.pas', mckRarProgBar in 'mckRarProgBar.pas', mckHTTP in 'mckHTTP.pas', + mckRAS in 'mckRAS.pas', + KOLRas in 'KOLRas.pas', + RAS in 'RAS.pas', UStr in 'UStr.pas', UWrd in 'UWrd.pas', KOLHTTP in 'KOLHTTP.pas', @@ -77,6 +85,7 @@ contains tinyPNG in 'tinyPNG.pas', tinyJPGGIFBMP in 'tinyJPGGIFBMP.pas', mckWebBrowser in 'mckWebBrowser.pas', - mckDHTML in 'mckDHTML.pas'; + mckDHTML in 'mckDHTML.pas', + KolZLibBzip in 'KolZLibBzip.pas'; end. diff --git a/Addons/addons_D7.dpk b/Addons/addons_D7.dpk index ccdac0b..b21a5f0 100644 --- a/Addons/addons_D7.dpk +++ b/Addons/addons_D7.dpk @@ -1,6 +1,6 @@ package addons_D7; -{$R addons.res} +{$R 'addons.res'} {$R 'mckCCtrls.dcr'} {$R 'mckHTTPDownload.dcr'} {$R 'mckQProgBar.dcr'} @@ -79,16 +79,10 @@ contains KOLPrinters in 'KOLPrinters.pas', mckXPMenus in 'mckXPMenus.pas', XPMenus in 'XPMenus.pas', - MCKGRushSplitterEditor in 'MCKGRushSplitterEditor.pas', - MCKGRushButtonEditor in 'MCKGRushButtonEditor.pas', - MCKGRushCheckBoxEditor in 'MCKGRushCheckBoxEditor.pas', - MCKGRushControls in 'MCKGRushControls.pas', - MCKGRushImageCollectionEditor in 'MCKGRushImageCollectionEditor.pas', - MCKGRushPanelEditor in 'MCKGRushPanelEditor.pas', - MCKGRushProgressBarEditor in 'MCKGRushProgressBarEditor.pas', - MCKGRushRadioBoxEditor in 'MCKGRushRadioBoxEditor.pas', tinyPNG in 'tinyPNG.pas', tinyJPGGIFBMP in 'tinyJPGGIFBMP.pas', - KOLGRushControls in 'KOLGRushControls.pas'; + mckWebBrowser in 'mckWebBrowser.pas', + mckDHTML in 'mckDHTML.pas', + KolZLibBzip in 'KolZLibBzip.pas'; end. diff --git a/KOL.pas b/KOL.pas index a0f7c3a..8cf2938 100644 --- a/KOL.pas +++ b/KOL.pas @@ -13,11 +13,9 @@ Key Objects Library (C) 2000 by Kladov Vladimir. -//[VERSION] **************************************************************** -* VERSION 2.93 +* VERSION 3.00.F **************************************************************** -//[END OF VERSION] K.O.L. - is a set of objects to create small programs with the Delphi, but without the VCL. KOL allows to @@ -39,7 +37,6 @@ ****************************************************************} -//[UNIT DEFINES] {$I KOLDEF.inc} {$IFDEF EXTERNAL_KOLDEFS} {$INCLUDE PROJECT_KOL_DEFS.INC} @@ -82,8 +79,7 @@ //test {$ENDIF LIN} -//[START OF UNIT] -unit KOL; {-} +unit KOL; {* Please note, that KOL does not use keyword 'class'. Instead, poor Pascal 'object' is the base of our objects. So, remember, @@ -438,6 +434,7 @@ unit KOL; {-} destroying using Add2AutoFree (smaller code). NOT_USE_AUTOFREE4CONTROLS - this option returns to previous behaviour (just to compare code size). Will be deprecated in future. + Ignored when UNION_FIELDS is used (by default) ENDSESSION_HALT - to halt the process when WM_ENDSESSION comes. FILESTREAM_POSITION - in PAS_VERSION, Stream..fData.fPosition always show current position (for debug purposes) @@ -477,14 +474,33 @@ unit KOL; {-} project directory, but not in the directory where KOL.pas is located. This is enough to provide different sets of defines for each project. + ---- from version 3.00, following symbols are added: + USE_FLAGS - to compress boolean flags used (about 6 bytes instead + more then 50 flags occupying earlies 1 byte for each + flag). This option is turned on by default. To turn off, + define a symbol USE_OLD_FLAGS ! + EVENTS_DYNAMIC - to create events record (about 600 bytes) only for + controls having assigned events. To turn off, define a + symbol EVENTS_STATIC. + NIL_EVENTS - by default, is off. This option returns back again checking + TControl's events if it is assigned before calling. By + default, now this option is off, all events are assigned + to dummy event handlers at create, so checking if the handler + is assigned is not necessary. But it is not allowed to + assign NIL to the event, instead call ResetEvent method + with the correspondent index (e.g. idx_fOnMessage). + COMMANDACTIONS_OBJ - to store command actions certain for different control + kinds in shared objects, separately from TControl object + instances. To turn off, define a symbol COMMANDACTIONS_RECORD. + PACK_COMMANDACTIONS - this option must be defined together with COMMANDACTIONS_OBJ + and must not with COMMANDACTIONS_RECORD (just do nothing + and this is applied automatically). | } {= K.O.L - ключевая библиотека объектов. (C) Кладов Владимир, 2000-2007. } -//[OPTIONS] {$A-} // align off, otherwise code is not good -{+} {$Q-} // no overflow check: this option makes code wrong {$R-} // no range checking: this option makes code wrong @@ -498,10 +514,13 @@ unit KOL; {-} {$IFDEF INPACKAGE} // use this symbol in packages requiring kol.pas {$WARNINGS OFF} - {$DEFINE NOT_USE_AUTOFREE4CONTROLS} + //{$DEFINE NOT_USE_AUTOFREE4CONTROLS} {$DEFINE PAS_VERSION} {$UNDEF ASM_VERSION} {$UNDEF ASM_UNICODE} + {$IFDEF _D2009orHigher} + {$DEFINE UNICODE_CTRLS} + {$ENDIF} {$ENDIF} {$IFDEF _D7orHigher} {$WARN UNSAFE_TYPE OFF} // Too many such warnings in Delphi7 @@ -509,7 +528,6 @@ unit KOL; {-} {$WARN UNSAFE_CAST OFF} {$ENDIF} -//[START OF INTERFACE] interface {$IFDEF NEW_ALIGN} @@ -532,6 +550,14 @@ interface {$DEFINE NEW_TRANSPARENT} {$ENDIF} +{$IFNDEF NOT_UNION_FIELDS} + {$DEFINE UNION_FIELDS} +{$ENDIF} + +{$IFDEF UNION_FIELDS} + {$UNDEF NOT_USE_AUTOFREE4CONTROLS} +{$ENDIF} + {$IFNDEF NOT_USE_AUTOFREE4CONTROLS} {$DEFINE USE_AUTOFREE4CONTROLS} {$DEFINE USE_AUTOFREE4CHILDREN} @@ -549,19 +575,16 @@ interface //{$DEFINE DEBUG_GDIOBJECTS} //{$DEFINE CHK_GDI} -//[USES] uses {$IFDEF WIN}messages, windows {$IFNDEF NOT_USE_RICHEDIT}, RichEdit {$ENDIF}{$ENDIF WIN} {$IFDEF LIN}, Libc, Xlib{$ENDIF} {$IFDEF GTK}, Glib2 , Gdk2, Gtk2, pango {$ENDIF GTK} {$IFDEF CHK_GDI}, ChkGdi {$ENDIF}; -//[END OF USES] {$IFDEF LIN} {$DEFINE global_declare} {$I KOL_Linux.inc} {$UNDEF global_declare} ////type HDC = TGC; // from Xlib (temporary definition?) {$ENDIF LIN} - var AppTheming: Boolean; {$IFDEF DEBUG_GDIOBJECTS} @@ -620,9 +643,6 @@ const {$ENDIF WIN} type -//[_TObj DEFINITION] - -{-} _TObj = object {* auxiliary object type. See TObj. } protected @@ -637,17 +657,16 @@ type {* Returns addres of virtual methods table of object. ? } {= возвращает адрес таблицы виртуальных методов (VMT). ? } end; -{+} - {++}(* TObj = class;*){--} - PObj = {-}^{+}TObj; + PObj = ^TObj; {* } - {++}(* TList = class;*){--} - PList = {-}^{+}TList; + PList = ^TList; {* } -//[TObjectMethod DECLARATION] + PPointerList = ^TPointerList; + TPointerList = array[0..MaxInt div 4 - 1] of Pointer; + TObjectMethod = procedure of object; {* } TOnEvent = procedure( Sender: PObj ) of object; @@ -657,19 +676,18 @@ type TOnEventMoving = procedure( Sender: PObj; P: PRect ) of object; -//[TPointerList DECLARATION] - PPointerList = ^TPointerList; - TPointerList = array[0..MaxInt div 4 - 1] of Pointer; - { --------------------------------------------------------------------- TObj - base object to derive all others ---------------------------------------------------------------------- } //[TObj DEFINITION] - TObj = {-} object( _TObj ) {+}{++}(*class*){--} + TObj = object( _TObj ) {* Prototype for all objects of KOL. All its methods are important to implement objects in a manner similar to Delphi TObject class. } {= Базовый класс для всех прочих объектов KOL. } protected + {$IFDEF DEBUG_OBJKIND} + fObjKind: PChar; + {$ENDIF} fRefCount: Integer; fOnDestroy: TOnEvent; {$IFDEF OLD_REFCOUNT} @@ -685,20 +703,19 @@ type fTag: DWORD; {* Custom data. } public - destructor Destroy; {-} virtual; {+}{++}(* override; *){--} + destructor Destroy; virtual; {* Disposes memory, allocated to an object. Does not release huge strings, dynamic arrays and so on. Such memory should be freeing in overriden destructor. } {= Освобождает память, выделенную для объекта. Не освобождает память, выделенную для строк, динамичиских массивов и т.п. Такая память должна быть освобождена в переопределенном деструкторе объекта. } - {++}(*protected*){--} - {++}(* - procedure Init; virtual; + {$IFnDEF NIL_EVENTS} + //procedure Init; virtual; {* Can be overriden in descendant objects to add initialization code there. (Main reason of intending is what constructors can not be virtual in poor objects). } - *){--} + {$ENDIF NIL_EVENTS} procedure Final; {* It is called in destructor to perform OnDestroy event call and to released objects, added to fAutoFree list. } @@ -751,11 +768,9 @@ type RefDec. } {$ENDIF NEW_FREE} - {-} // By Vyacheslav Gavrik: function InstanceSize: Integer; {* Returns a size of object instance. } - {+} constructor Create; {* Constructor. Do not call it. Instead, use New function @@ -763,14 +778,11 @@ type {= Конструктор. Не следует вызывать его. Для конструирования объектов, вызывайте соответствующую глобальную функцию New<имя-объекта>. Например, NewLabel( MyForm, 'Метка№1' ); } - {-} class function AncestorOfObject( Obj: Pointer ): Boolean; {* Is intended to replace 'is' operator, which is not applicable to objects. } - {= } function VmtAddr: Pointer; {* Returns addres of virtual methods table of object. } {= возвращает алрес таблицы виртуальных методов (VMT). } - {+} property OnDestroy: TOnEvent read fOnDestroy write fOnDestroy; {* This event is provided for any KOL object, so You can provide your own OnDestroy event for it. } @@ -807,12 +819,10 @@ type function FindObj(const ObjName: Ansistring): PObj; {$ENDIF} end; -//[END OF TObj DEFINITION] { --------------------------------------------------------------------- TList - object to implement list of pointers (or dwords) ---------------------------------------------------------------------- } -//[TList DEFINITION] TList = object( TObj ) {* Simple list of pointers. It is used in KOL instead of standard VCL TList to store any kind data (or pointers to these ones). Can be created @@ -825,12 +835,9 @@ type fAddBy: Integer; procedure SetCount(const Value: Integer); procedure SetAddBy(Value: Integer); - {++}(*public*){--} - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* Destroys list, freeing memory, allocated for pointers. Programmer is resposible for destroying of data, referenced by the pointers. } - {= } - {++}(*protected*){--} procedure SetCapacity( Value: Integer ); function Get( Idx: Integer ): Pointer; procedure Put( Idx: Integer; Value: Pointer ); @@ -863,7 +870,7 @@ type follow item indeces up by one. } procedure DeleteRange( Idx, Len: Integer ); {* Deletes Len items starting from Idx. } - function Remove(Value: Pointer): Integer; + procedure Remove( Value: Pointer ); {* Removes first entry of a Value in the list. } property Count: Integer read fCount write SetCount; {* Returns count of items in the list. It is possible to delete a number @@ -913,9 +920,7 @@ type property UseBlocks: Boolean read fUseBlocks write fUseBlocks; {$ENDIF} end; -//[END OF TList DEFINITION] -//[NewList DECLARATION] function NewList: PList; {* Returns pointer to newly created TList object. Use it instead usual TList.Create as it is done in VCL or XCL. } @@ -936,22 +941,15 @@ procedure Free_And_Nil( var Obj ); (TControl, TMenu, etc.) This procedure is not compatible with VCL's FreeAndNil, which works with TObject, since this it has another name. } - -//[DummyObjProc, DummyObjProcParam DECLARATION] -procedure DummyObjProc( Sender: PObj ); -procedure DummyObjProcParam( Sender: PObj; Param: Pointer ); - {$IFDEF WIN_GDI} -{ --- threads --- } -//[THREADS] +{ ------------------------------- threads ------------------------------------ } const ABOVE_NORMAL_PRIORITY_CLASS = $8000; // only for Windows 2K BELOW_NORMAL_PRIORITY_CLASS = $4000; // and higher ! type - {++}(*TThread = class;*){--} - PThread = {-}^{+}TThread; + PThread = ^TThread; TThreadMethod = procedure of object; TThreadMethodEx = procedure( Sender: PThread; Param: Pointer ) of object; @@ -962,7 +960,6 @@ type { --------------------------------------------------------------------- TThread object ---------------------------------------------------------------------- } -//[TThread DEFINITION] TThread = object(TObj) private function GetPriorityBoost: Boolean; @@ -995,8 +992,7 @@ type procedure SetPriorityCls(Value: Integer); procedure SetThrdPriority(Value: Integer); procedure Init; virtual; - {++}(*public*){--} - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* } public {$IFDEF PSEUDO_THREADS} @@ -1076,9 +1072,7 @@ type property PriorityBoost: Boolean read GetPriorityBoost write SetPriorityBoost; {* By default, priority boost is enabled for all threads. } end; -//[END OF TThread DEFINITION] -//[NewThread, NewThreadEx, NewThreadAutoFree DECLARATIONS] function NewThread: PThread; {* Creates thread object (always suspended). After creating, set event OnExecute and perform Resume operation. } @@ -1103,8 +1097,7 @@ function WaitForMultipleObjects( nCount: DWORD; procedure Sleep( n: DWORD ); {$ENDIF} -{ -- streams -- } -//[STREAMS] +{ ----------------------------------- streams -------------------------------- } {$ENDIF WIN_GDI} type @@ -1126,8 +1119,7 @@ type {$ENDIF} {$ENDIF} - {++}(*TStream = class;*){--} - PStream = {-}^{+}TStream; + PStream = ^TStream; PStreamMethods = ^TStreamMethods; TStreamMethods = Packed Record @@ -1159,7 +1151,6 @@ type { --------------------------------------------------------------------- TStream - streaming objects incapsulation ---------------------------------------------------------------------- } -//[TStream DEFINITION] TStream = object(TObj) {* Simple stream object. Can be opened for file, or as memory stream (see NewReadFileStream, NewWriteFileStream, NewMemoryStream, etc.). And, another @@ -1184,8 +1175,7 @@ type function GetPosition: TStrmSize; function GetSize: TStrmSize; procedure SetSize(const NewSize: TStrmSize); - {++}(*public*){--} - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; public function Read(var Buffer; const Count: TStrmSize): TStrmSize; {* Reads Count bytes from a stream. Returns number of bytes read. } @@ -1290,9 +1280,7 @@ type or replace reading / writing methods to certain supporting OnChangePos event. } end; -//[END OF TStream DEFINITION] -//[_NewStream DECLARATION] function _NewStream( const StreamMethods: TStreamMethods ): PStream; {* Use this method only to define your own stream type. See also declared below (in KOL.pas) methods used to implement standard KOL streams. You can use it in @@ -1347,7 +1335,6 @@ function DummyReadWrite( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} cons procedure DummySetSize( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Value: TStrmSize ); procedure DummyStreamProc(Strm: PStream); -//[NewFileStream DECLARATION] function NewFileStream( const FileName: KOLString; Options: DWORD ): PStream; {* Creates file stream for read and write. Exact set of open attributes should be passed through Options parameter (see FileCreate where those @@ -1395,7 +1382,6 @@ function NewExFileStream( F: HFile ): PStream; When stream is destroyed, file handle still not closed (your code should do this) and file position is not changed (after the last read operation). } -//[NewMemoryStream DECLARATION] function NewMemoryStream: PStream; {* Creates memory stream (read and write). } @@ -1456,7 +1442,6 @@ function NewSubStream( BaseStream: PStream; const FromPos, Size: TStrmSize ): PS can be treated as usual stream. } -//[Stream2Stream DECLARATION] function Stream2Stream( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; {* Copies Count (or less, if the rest of Src is not sufficiently long) bytes from Src to Dst, but with optimizing in cases, when Src or/and @@ -1469,8 +1454,6 @@ function Stream2StreamExBufSz( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {* Copies Count bytes from Src to Dst using buffer of given size, but without other optimizations. Unlike Stream2Stream function, it can be applied to very large streams } - -//[Resource2Stream DECLARATION] function Resource2Stream( DestStrm : PStream; Inst : HInst; ResName : PKOLChar; ResType : PKOLChar ): Integer; {* Loads given resource to DestStrm. Useful for non-standard @@ -1509,13 +1492,11 @@ RT_VERSION Version resource } {$ENDIF WIN_GDI} -{ -- string list objects -- } -//[TStrList] +{ ------------------------- string list objects ------------------------------ } type TCompareStrListFun = function( const S1, S2: PAnsiChar ): Integer; -//[Sorting TYPES] TCompareEvent = function (const Data: Pointer; const e1,e2 : Dword) : Integer; {* Event type to define comparison function between two elements of an array. This event handler must return -1 or +1 (correspondently for cases e1       + | Method.Code := @MyProcedure; + | } + Data: Pointer; // Pointer to object, owning the method. + {* To fake event of type 'procedure of object' with setting it to + ordinal procedure assign here NIL; } + end; + {* When assigning TMethod record to event handler, typecast it with + desired event type, e.g.: + |
       + | SomeObject.OnSomeEvent := TOnSomeEvent( Method ); + |
} +/////////////////////////////////////////// +{$endif} // +/////////////////////////////////////////// + PMethod = ^TMethod; + {* } + + function MakeMethod( Data, Code: Pointer ): TMethod; + {* Help function to construct TMethod record. Can be useful to + assign regular type procedure/function as event handler for + event, defined as object method (do not forget, that in that + case it must have first dummy parameter to replace @Self, + passed in EAX to methods of object). } + +type + T3Style = ( F3_Maximize, F3_ClipChildren, F3_ClipSiblings, + F3_Disabled, F3_Visible, F3_Minimize, + F3_Child, F3_Popup ); + T3Styles = Set of T3Style; + + T2Style = ( F2_Tabstop, F2_Group, F2_Thickframe, F2_Sysmenu, + F2_HScroll, F2_VScroll, F2_Dlgframe, F2_Border ); + T2Styles = Set of T2Style; + + TStyle = packed record + CASE Integer OF + 1: ( + f0_Style: Byte; + f1_Style: Byte; + f2_Style: T2Styles; + f3_Style: T3Styles; + ); + 2: ( Value: DWORD; ); + end; + + T1Flag = ( G1_WordWrap, G1_PreventResize, G1_IconShared, + G1_IgnoreWndCaption, G1_SizeRedraw, G1_IsStaticControl, + G1_CanNotDoublebuf, G1_NotUpdate ); // + T1Flags = Set of T1Flag; + + T2Flag = ( G2_Transparent, G2_DoubleBuffered, G2_ClassicTransparent, + G2_Destroying, G2_BeginDestroying, + G2_ChangedPos, G2_ChangedSize, G2_Focused ); // + T2Flags = Set of T2Flag; + + T3Flag = ( G3_ClassicTransparent, G3_IsForm, G3_SizeGrip, G3_IsControl, + G3_IsApplet, G3_IsMDIChild, G3_Flat, G3_MouseInCtl ); // + T3Flags = Set of T3Flag; + + T4Flag = ( G4_CreateHidden, G4_VisibleWOParent, G4_NotUseAlign, + G4_CreateVisible, G4_Pushed, G4_Checked, G4_Hot, G4_Pressed ); // + // use G4_Pushed also as KeyPreviewing for form + T4Flags = Set of T4Flag; + + T5Flag = ( G5_IsButton, G5_IsBitBtn, G5_IsSplitter, G5_IsGroupbox, + G5_IsCommonCtl, G5_3ButtonPress, G5_EraseBkgnd, G5_IgnoreDefault ); + T5Flags = Set of T5Flag; + + T6Flag = ( G6_KeyPreview, G6_AllBtnReturnClick, G6_DefaultBtn, G6_CancelBtn, + G6_GraphicCtl, G6_CtlClassNameChg, G6_RightClick, G6_Dragging ); + T6Flags = Set of T6Flag; + + PControl = ^TControl; {* Type of pointer to TControl visual object. All | constructing functions @@ -3771,17 +3830,15 @@ type it is necessary to apply suffix '^' to pointer to get know to compiler, what do You want. } {$IFDEF WIN} -//[TWindowFunc TYPE] TWindowFunc = function( Sender: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; -{$ENDIF WIN} {* Event type to define custom extended message handlers (as pointers to procedure entry points). Such handlers are usually defined like add-ons, extending behaviour of certain controls and attached using AttachProc method of TControl. If the handler detects, that it is necessary to stop further message processing, it should return True. } +{$ENDIF WIN} -//[Mouse TYPES] TMouseButton = ( mbNone, mbLeft, mbRight, mbMiddle ); {* Available mouse buttons. mbNone is useful to get know, that there were no mouse buttons pressed. } @@ -3800,7 +3857,6 @@ type TOnMouse = procedure( Sender: PControl; var Mouse: TMouseEventData ) of object; {* Common mouse handling event type. } -//[Key TYPES] TOnKey = procedure( Sender: PControl; var Key: Longint; Shift: DWORD ) of object; {* Key events. Shift is a combination of flags MK_SHIFT, MK_CONTROL, MK_ALT. (See GetShiftState funtion). } @@ -3814,7 +3870,6 @@ type {* Set of tabulating key groups, allowed to be used in with a control (are installed by TControl.LookTabKey property). } -//[Event TYPES] {$IFDEF WIN} TOnMessage = function( var Msg: TMsg; var Rslt: Integer ): Boolean of object; {* Event type for events, which allows to extend behaviour of windowed controls @@ -3849,7 +3904,7 @@ type TOnTVDelete = procedure( Sender: PControl; Item: THandle ) of object; {* Event type for OnTVDelete event. } - //--------- by Sergey Shisminzev: + //--------- by Sergey Shisminzev : TOnTVSelChanging = function(Sender: PControl; oldItem, newItem: THandle): Boolean //~ss of object; {* When the handler returns False, selection is not changed. } @@ -3868,7 +3923,6 @@ type ScrX, ScrY are screen coordinates of the mouse cursor. } {$IFDEF WIN} -//[Create Window STRUCTURES] TCreateParams = packed record {* Record to pass it through CreateSubClass method. } Caption: PKOLChar; @@ -3896,32 +3950,57 @@ type WindowClass: TWndClass; end; -//[COMMAND ACTIONS TYPE FOR DIFFERENT CONTROLS] PCommandActions = ^TCommandActions; TCommandActions = packed Record aClear: procedure( Sender: PControl ); aAddText: procedure( Sender: PControl; const S: AnsiString ); - aClick, aEnter, aLeave: WORD; aChange: SmallInt; aSelChange: SmallInt; + aClick, aEnter, aLeave: WORD; + aChange: SmallInt; aSelChange: SmallInt; aGetCount, aSetCount, aGetItemLength, aGetItemText, aSetItemText, aGetItemData, aSetItemData: WORD; aAddItem, aDeleteItem, aInsertItem: WORD; aFindItem, aFindPartial: WORD; - aItem2Pos, aPos2Item: BYTE; - {aGetSelStart,} aGetSelCount, aGetSelected, aGetSelRange, - {aExGetSelRange,} aGetCurrent, + bItem2Pos, bPos2Item: BYTE; + aGetSelCount, aGetSelected, aGetSelRange, + aGetCurrent, aSetSelected, aSetCurrent, aSetSelRange, aExSetSelRange, aGetSelection, aReplaceSel: WORD; aTextAlignLeft, aTextAlignRight, aTextAlignCenter: WORD; - aTextAlignMask: Byte; - aVertAlignCenter, aVertAlignTop, aVertAlignBottom: Byte; + bTextAlignMask: Byte; + bVertAlignCenter, bVertAlignTop, bVertAlignBottom: Byte; aDir, aSetLimit: Word; aSetImgList: Word; - aAutoSzX, aAutoSzY: Word; aSetBkColor: Word; aItem2XY: Word; end; + + {$IFDEF COMMANDACTIONS_OBJ} + PCommandActionsObj = ^TCommandActionsObj; + TCommandActionsObj = object(TObj) + aClear: procedure( Sender: PControl ); + aAddText: procedure( Sender: PControl; const S: KOLString ); + aClick, aEnter, aLeave: WORD; + aChange: SmallInt; aSelChange: SmallInt; + aGetCount, aSetCount, aGetItemLength, aGetItemText, aSetItemText, + aGetItemData, aSetItemData: WORD; + aAddItem, aDeleteItem, aInsertItem: WORD; + aFindItem, aFindPartial: WORD; + bItem2Pos, bPos2Item: BYTE; + aGetSelCount, aGetSelected, aGetSelRange, + aGetCurrent, + aSetSelected, aSetCurrent, aSetSelRange, aExSetSelRange, + aGetSelection, aReplaceSel: WORD; + aTextAlignLeft, aTextAlignRight, aTextAlignCenter: WORD; + bTextAlignMask: Byte; + bVertAlignCenter, bVertAlignTop, bVertAlignBottom: Byte; + aDir, aSetLimit: Word; aSetImgList: Word; + aSetBkColor: Word; + aItem2XY: Word; + fIndexInActions: Integer; + destructor Destroy; virtual; + end; + {$ENDIF} {$ENDIF WIN} -//[Align TYPES] TTextAlign = ( taLeft, taRight, taCenter ); {* Text alignments available. } TRichTextAlign = ( raLeft, raRight, raCenter, @@ -3936,7 +4015,6 @@ type TAligning = (oaWaitAlign,oaFromSelf,oaAligning); TAlignings = set of TAligning; -//[BitBtn TYPES] TBitBtnOption = ( bboImageList, bboNoBorder, bboNoCaption, @@ -3957,7 +4035,6 @@ type highlighting is provided only if property Flat is set to True (or one of events OnMouseEnter / OnMouseLeave is assigned to something). } -//[ListView TYPES] TListViewStyle = ( lvsIcon, lvsSmallIcon, lvsList, lvsDetail, lvsDetailNoHeader ); {* Styles of view for ListView control (see NewListVew). } @@ -4072,7 +4149,6 @@ type : DWORD of object; {* Event type for OnLVCustomDraw event. } -//[Paint TYPES] TOnPaint = procedure( Sender: PControl; DC: HDC ) of object; TPaintProc = procedure( DC: HDC ) of object; @@ -4086,7 +4162,6 @@ type TGradientStyle, means either position of first line of first rectangle (ellipse) to be expanded in a loop to fit entire gradient panel area. } -//[Edit TYPES] TEditOption = ( eoNoHScroll, eoNoVScroll, eoLowercase, eoMultiline, eoNoHideSel, eoOemConvert, eoPassword, eoReadonly, eoUpperCase, eoWantReturn, eoWantTab, eoNumber ); @@ -4163,19 +4238,19 @@ type {$IFDEF _D3orHigher} TCharFormat = TCharFormat2; {$ENDIF _D3orHigher} + PCharFormat = ^TCharFormat; TParaFormat = TParaFormat2; {$ENDIF NOT_USE_RICHEDIT} TOnTestMouseOver = function( Sender: PControl ): Boolean of object; {* Event type for TControl.OnTestMouseOver event. The handler should - return True, if it dectects, that mouse is over control. } + return True, if it detects if the mouse is over control. } TEdgeStyle = ( esRaised, esLowered, esNone, esTransparent, esSolid ); {* Edge styles (for panel - see NewPanel). esTransparent and esSolid - special styles equivalent to esNone except GRushControls are used via USE_GRUSH symbol (ToGRush.pas) } -//[List TYPES] TListOption = ( loNoHideScroll, loNoExtendSel, loMultiColumn, loMultiSelect, loNoIntegralHeight, loNoSel, loSort, loTabstops, loNoStrings, loNoData, loOwnerDrawFixed, loOwnerDrawVariable, @@ -4193,13 +4268,11 @@ type TComboOptions = Set of TComboOption; {* Set of options available for combobox. } -//[Progress TYPES] TProgressbarOption = ( pboVertical, pboSmooth ); {* Options for progress bar. } TProgressbarOptions = set of TProgressbarOption; {* Set of options available for progress bar. } -//[TreeView TYPES] TTreeViewOption = ( tvoNoLines, tvoLinesRoot, tvoNoButtons, tvoEditLabels, tvoHideSel, tvoDragDrop, tvoNoTooltips, tvoCheckBoxes, tvoTrackSelect, tvoSingleExpand, tvoInfoTip, tvoFullRowSelect, tvoNoScroll, @@ -4208,7 +4281,6 @@ type TTreeViewOptions = set of TTreeViewOption; {* Set of tree view options. } -//[TabControl TYPES] TTabControlOption = ( tcoButtons, tcoFixedWidth, tcoFocusTabs, tcoIconLeft, tcoLabelLeft, tcoMultiline, tcoMultiselect, tcoFitRows, tcoScrollOpposite, @@ -4219,7 +4291,6 @@ type {* Set of options, available for TAbControl during its creation (by NewTabControl function). } -//[Toolbar TYPES] TToolbarOption = ( tboTextRight, tboTextBottom, tboFlat, tboTransparent, tboWrapable, tboNoDivider, tbo3DBorder, tboCustomErase ); {* Toolbar options. When tboFlat is set and toolbar is placed onto panel, @@ -4243,10 +4314,15 @@ type FromDate, ToDate: TDateTime; end; {* } - TDateTimePickerColor = ( dtpcBackground, dtpcMonthBk, dtpcText, dtpcTitleBk, - dtpcTitleText, dtpcTrailingText ); + TDateTimePickerColor = ( dtpcBackground, dtpcText, dtpcTitleBk, + dtpcTitleText, dtpcMonthBk, dtpcTrailingText ); + {MCSC_BACKGROUND = 0; // the background color (between months) + MCSC_TEXT = 1; // the dates + MCSC_TITLEBK = 2; // background of the title + MCSC_TITLETEXT = 3; + MCSC_MONTHBK = 4; // background within the month cal + MCSC_TRAILINGTEXT = 5; // the text color of header & trailing days} -//[TOnDropFiles TYPE] TOnDropFiles = procedure( Sender: PControl; const FileList: KOL_String; const Pt: TPoint ) of object; {* An event type for OnDropFiles event. When the event is occur, FileList parameter contains a list of files dropped. File names in a list are @@ -4266,18 +4342,15 @@ type ! FList.Free; ! end; } -//[Scroll TYPES] TScrollerBar = ( sbHorizontal, sbVertical ); TScrollerBars = set of TScrollerBar; TOnScroll = procedure( Sender: PControl; Bar: TScrollerBar; ScrollCmd: DWORD; ThumbPos: DWORD ) of object; -//[TOnHelp EVENT TYPE] TOnHelp = procedure( var Sender: PControl; var Context: Integer; var Popup: Boolean ) of object; -//[ScrollBar TYPES] TOnSBBeforeScroll = procedure( Sender: PControl; OldPos, NewPos: Integer; Cmd: Word; @@ -4291,23 +4364,359 @@ type {$IFDEF _X_} //---- in GTK+, each type of widget requieres its own getcaption/setcaption call - TGetCaption = function( Ctl: PControl ): KOLString; - TSetCaption = procedure( Ctl: PControl; const Value: KOLString ); + TGetCaption = FUNCTION( Ctl: PControl ): KOLString; + TSetCaption = PROCEDURE( Ctl: PControl; CONST Value: KOLString ); {$IFDEF GTK} //---- in GTK+, to allow setting absolute position for children, // we should use one of special clients like gtk_fixed, gtk_layout - TGetClientArea = function( Ctl: PControl ): PGtkWidget; - TChildSetPos = procedure( Ctl, Chld: PControl; x, y: Integer ); + TGetClientArea = FUNCTION( Ctl: PControl ): PGtkWidget; + TChildSetPos = PROCEDURE( Ctl, Chld: PControl; x, y: Integer ); {$ENDIF GTK} {$ENDIF _X_} + TFormInitFunc = function(Form: PControl): PControl; + TFormInitFunc1 = function(Form: PControl; intParam: Integer): PControl; + TFormInitFuncArray = array[0..65535] of TFormInitFunc; + TFormInitFuncArray1 = array[0..65535] of TFormInitFunc1; + PFormInitFuncArray = ^TFormInitFuncArray; + PFormInitFuncArray1 = ^TFormInitFuncArray1; + + TSmallIntArray = array[0..65535] of SmallInt; + PSmallIntArray = ^TSmallIntArray; + + PPControl = ^PControl; + {$IFDEF USE_MHTOOLTIP} {$DEFINE pre_interface} {$I KOLMHToolTip} {$UNDEF pre_interface} {$ENDIF} + TOnWndFunc = function( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; + TProcSender = procedure( Sender: PObj ); + TOnGotoControl = function( Self_: PControl; Key: DWORD; CheckOnly: Boolean ): Boolean; + + PEvents = ^TEvents; + TEvents = record + CASE Integer OF + 1:( + //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + //................... most common events ................................... + fOnMessage: TOnMessage; + fOldOnMessage: TOnMessage; // for applet only but... + fOnClick: TOnEvent; + fOnMouseDown: TOnMouse; // CAUTION!!! Order of mouse event handlers is important. ____ + fOnMouseUp: TOnMouse; // + fOnMouseMove: TOnMouse; // + fOnMouseDblClk: TOnMouse; // + fOnMouseWheel: TOnMouse; //_____________________________________________________// + + fOnMouseEnter: TOnEvent; + fOnMouseLeave: TOnEvent; + fOnTestMouseOver: TOnTestMouseOver; // mainly for bitbtn but... + fGraphCtlMouseEvent: TOnGraphCtlMouse; + fMouseLeaveProc: TOnEvent; + fOnScroll: TOnScroll; + + fOnChar: TOnChar; + fOnDeadChar: TOnChar; + fOnKeyUp: TOnKey; + fOnKeyDown: TOnKey; + + fOnChange: TOnEvent; + fOnEnter: TOnEvent; + fOnLeave: TOnEvent; + fLeave: TOnEvent; + + fOnPaint: TOnPaint; + fOnPaint2: TOnPaint; + fOnPrepaint: TOnPaint; + fOnPostPaint: TOnPaint; + fPaintProc: TPaintProc; + fOnEraseBkgnd: TOnPaint; + fOnDrawItem: TOnDrawItem; + fOnMeasureItem: TOnMeasureItem; + + fDragCallback: TOnDrag; + + fOnSelChange: TOnEvent; + fOnResize: TOnEvent; + + fOnHide: TOnEvent; + fOnShow: TOnEvent; + + fOnClose: TOnEventAccept; // mainly for form but... + + fOnMove: TOnEvent; + fOnMoving: TOnEventMoving; + fOnHelp: TOnHelp; + //................... other events ......................................... + fOnQueryEndSession: TOnEventAccept; + + //----- order of following 3 events important: // for form only ? + fOnMinimize: TOnEvent; // + fOnMaximize: TOnEvent; // + fOnRestore: TOnEvent; // + //---------------------------------------------// + + fOnLVCustomDraw: TOnLVCustomDraw; + fOnEndEditLVItem: TOnEditLVItem; + fOnLVData: TOnLVData; + fOnCompareLVItems: TOnCompareLVItems; + FOnLVStateChange: TOnLVStateChange; + fOnDeleteLVItem: TOnDeleteLVItem; + fOnColumnClick: TOnLVColumnClick; + + FOnTVEndEdit: TOnTVEndEdit; + FOnTVExpanded: TOnTVExpanded; + FOnTVExpanding: TOnTVExpanding; + FOnTVSelChanging: TOnTVSelChanging; + + FOnSBBeforeScroll: TOnSBBeforeScroll; + FOnSBScroll: TOnSBScroll; + + FOnDropDown: TOnEvent; + FOnCloseUp: TOnEvent; + + FOnSplit: TOnSplit; + + FOnProgress: TOnEvent; + + FOnBitBtnDraw: TOnBitBtnDraw; + + FOnTVBeginDrag: TOnTVBeginDrag; + FOnTVBeginEdit: TOnTVBeginEdit; + FOnTVDelete: TOnTVDelete; + + FOnDTPUserString: TDTParseInputEvent; + + FOnREInsModeChg: TOnEvent; + FOnREOverURL: TOnEvent; + FOnREURLClick: TOnEvent; + fOnDropFiles: TOnDropFiles; + ); + 2: ( MethodEvents: array[ 0..idx_LastEvent ] of TMethod; + ); + end; + + TProcedures = record + CASE Integer OF + 1: ( + //.......................................................................... + fWndFunc: Pointer; + fDoInvalidate: TProcSender; + fOnDynHandlers: TWindowFunc; + fPass2DefProc: TOnWndFunc; + fWndProcKeybd: TOnWndFunc; + fControlClick: TProcSender; // + fAutoSize: TProcSender; + //{-2.95}//fWndProcResizeFlicks: TOnWndFunc; + fGotoControl: TOnGotoControl; + {* Initially pointer to WndFunc. For MDI child window, points to DefMDIChildProc. } + fNotifyChild: procedure( Self_, Child: PControl ); + fScrollChildren: procedure( Self_: PControl ); + fCreateWndExt: procedure( Sender: PControl ); + fExMsgProc: function( Applet: PControl; var Msg: TMsg ): Boolean; + {* Additional message handler called directly from Applet.ProcessMessage. + Used to call TranslateMDISysAccel API function for MDI application. } + ); + 2: ( Procedures: array[ 0..idx_LastProc-idx_LastEvent-1 ] of Pointer; + ); + end; + + // data fields of TControl which are certain for different kinds of control + // -- so these can be alternated using variant record type to economy run time + // size of TControl object instance + TDataFields = packed record + {$IFDEF UNION_FIELDS} + CASE Integer OF + 1:( // Toolbar control fields + {$ENDIF} + fOnTBCustomDraw: TOnTBCustomDraw; + fTBevents: PList; // events for TBAssignEvents + fTBBtnImgWidth: Integer; // custom toolbar bitmap width + fTBBtMinWidth: Integer; + fTBBtMaxWidth: Integer; + fTBttCmd: PList; + fTBttTxt: {$IFDEF UNICODE_CTRLS} PWStrList {$ELSE} PStrList {$ENDIF}; + fTBCurItem: Integer; + fDefaultTBBtnStyle: Byte; // for Toolbars + fTBDropped: Boolean; + {$IFDEF UNION_FIELDS} + ); + 2:( // Combobox + Group box + {$ENDIF} + fDroppedWidth: Integer; // SmallInt; + fDropDownCount: Cardinal; + fCurIdxAtDrop: Integer; + fErasingBkgnd: Boolean; // for Group box + {$IFDEF UNION_FIELDS} + ); + 3:( // Form + Applet + {$ENDIF} + fModalResult: Integer; + fModalForm: PControl; + fCurrentControl: PControl; + //FMinimizeWnd: PControl; + fIcon: HIcon; + + {$IFDEF USE_GRAPHCTLS} + {$IFDEF GRAPHCTL_HOTTRACK} + fHotCtl: PControl; + {$ENDIF} + {$ENDIF} + //fDefaultBtnCtl: PControl; + //fCancelBtnCtl: PControl; + fWindowState: TWindowState; + fActivating: Boolean; + fCloseQueryReason: TCloseQueryReason; + fFixingModal: ShortInt; + fShowAction: Byte; + fKeyPreviewCount: Byte; + fModal: Byte; + fReserved_Form: Byte; + //-- внимание! порядок следующих 3х полей не должен меняться!!! + FormCurrentParent: PControl; + {* контрол, использующийся в качестве родительского, в функциях создания } + FormParams: PAnsiChar; + {* строка команд и параметров } + FormAddress: PPControl; + {* адрес поля Form в объекте формы MCK - нужен для вычисления адресов + контролов по смещению, для функции FormSetCurCtl } + FormObj: PObj; + FormAlphabet: PFormInitFuncArray; + {* алфавит процедур } + FormLastCreatedChild: PControl; + {* контрол, созданный последним } + {$IFDEF UNION_FIELDS} + ); + 4:( // ListView + {$ENDIF} + fColumn: Integer; // for listview only (column to sort) + fOnDeleteAllLVItems: TOnEvent; + fCtlImageListSml: PImageList; + {* ImageList object (with small icons 16x16) to use with a control (e.g., + with ListView control). + If not set, but control has a list of image list objects, last added + image list with small icons is used automatically. } + fCtlImageListNormal: PImageList; + {* ImageList object (with big icons 32x32) to use with a control. + If not set, last added image list with big icons is used. } + fCtlImgListState: PImageList; + {* ImageList object to use as a state image list (for ListView control). } + fLVColCount: Integer; + fLVTextBkColor: TColor; + fLVItemHeight: Integer; + fLVOptions: TListViewOptions; + fLVStyle: TListViewStyle; + {$IFDEF UNION_FIELDS} + ); + 5:( // Rich Edit -- 11 dwords + {$ENDIF} + {$IFNDEF NOT_USE_RICHEDIT} + {$IFDEF STATIC_RICHEDIT_DATA} + fRECharFormatRec: TCharFormat; + fREParaFmtRec: TParaFormat2; + {$ELSE} + fRECharFormatRec: PCharFormat; + fREParaFmtRec: PParaFormat2; + {$ENDIF} + fCharFmtDeltaSz: Integer; + fParaFmtDeltaSz: Integer; + fREError: Integer; + fREStream: PStream; + fREStrLoadLen: DWORD; + fREUrl: PKOLChar; + fTmpFont: PGraphicTool; // for RichEdit + fREUpdCount: SmallInt; + fReOvrDisable: Boolean; + fREOvr: Boolean; + fREScrolling: Boolean; + fRECharArea: TRichFmtArea; + FSupressTab: Boolean; + fRETransparent: Boolean; + {$ENDIF NOT_USE_RICHEDIT} + {$IFDEF UNION_FIELDS} + ); + 6:( // Label Effect + Graphic edit control + {$ENDIF} + fShadowDeep: Integer; + fEditCtl: PControl; + fEditOptions: TEditOptions; + {$IFDEF UNION_FIELDS} + ); + 7:( // BitBtn + {$ENDIF} + fGlyphBitmap : HBitmap; + fGlyphCount : Integer; + fGlyphWidth, fGlyphHeight: Integer; + fRepeatInterval: Integer; + fTextShiftX, fTextShiftY: Integer; + fBitBtnDrawMnemonic: Boolean; + fBitBtnOptions : TBitBtnOptions; + fGlyphLayout : TGlyphLayout; + fButtonIcon: HIcon; // for Graphic button control though... + FBitBtnGetCaption: function( Self_: PControl; const S: KOLString ): KOLString; + FBitBtnExtDraw: procedure( Self_: PControl; DC: HDC; X, Y: Integer; const R: TRect; + const CapText, CapTxtOrig: KOLString; Color: TColor ); + {$IFDEF UNION_FIELDS} + ); + 8:( // Splitter + {$ENDIF} + fSplitStartPos: TPoint; + fSplitStartPos2: TPoint; + fSplitStartSize: Integer; + fSplitMinSize1, fSplitMinSize2: Integer; + fSecondControl: PControl; + {$IFDEF UNION_FIELDS} + ); + 9:( // Gradient panel + {$ENDIF} + fColor1: TColor; + fColor2: TColor; + fGradientStyle: TGradientStyle; + fGradientLayout: TGradientLayout; + {$IFDEF UNION_FIELDS} + ); + 10:( // Tree view only + {$ENDIF} + fTVRightClickSelect: Boolean; + {$IFDEF UNION_FIELDS} + ); + 11:( // Scroll Bar + {$ENDIF} + FScrollLineDist: array[ 0..1 ] of Integer; + fSBMinMax: TPoint; + fSBPageSize: Integer; + fSBPosition: Integer; + {$IFDEF UNION_FIELDS} + ); + 100:( // for custom controls + {$ENDIF} + //fCustom6: Integer; + //fCustEvent2: TOnEvent; + fCustom5: Integer; + fCustom4: Integer; + fCustEvent1: TOnEvent; + fCustom3: Integer; + fCustom2: Integer; + fCustEvent0: TOnEvent; + fCustom1: Integer; + fCustom0: Integer; + fCustFlag7: Boolean; + fCustFlag6: Boolean; + fCustFlag5: Boolean; + fCustFlag4: Boolean; + fCustFlag3: Byte; + fCustFlag2: Byte; + fCustFlag1: Byte; + fCustFlag0: Byte; + {$IFDEF UNION_FIELDS} + ); + {$ENDIF} + end; + { ---------------------------------------------------------------------- TControl - object to implement any visual control ----------------------------------------------------------------------- } @@ -4325,17 +4734,146 @@ type See also notes about certain control kinds, located together with its | |constructing functions definitions. } + protected + function GetAnchor(const Index: Integer): Boolean; + procedure SetAnchor(const Index: Integer; const Value: Boolean); + function Get_StatusWnd: HWND; + function Get_Prop_Int(PropName: PKOLChar): Integer; + procedure Set_Prop_Int(PropName: PKOLChar; const Value: Integer); + function GetHelpContext: Integer; + function Get_MDIClient: PControl; + procedure Set_MDIClient(const Value: PControl); + function Get_Ctl3D: Boolean; + function Get_OnMouseEvent(const Index: Integer): TOnMouse; + public + procedure SetOnMouseEvent(const Index: Integer; const Value: TOnMouse); + protected + {$IFDEF EVENTS_DYNAMIC} + function Get_TOnEvent(const Index: Integer): TOnEvent; + function Get_OnMessage: TOnMessage; + function Get_OnHelp: TOnHelp; + function Get_OnBitBtnDraw: TOnBitBtnDraw; + function Get_OnMeasureItem: TOnMeasureItem; + function Get_OnShow: TOnEvent; + function Get_OnHide: TOnEvent; + function Get_OnClose: TOnEventAccept; + function Get_OnQueryEndSession: TOnEventAccept; + function Get_OnPaint: TOnPaint; + function Get_OnPrePaint: TOnPaint; + function Get_OnPostPaint: TOnPaint; + function Get_OnEraseBkgnd: TOnPaint; + function Get_OnClick: TOnEvent; + function Get_OnResize: TOnEvent; + function Get_OnMove: TOnEvent; + function Get_OnMoving: TOnEventMoving; + function Get_OnSplit: TOnSplit; + function Get_OnKeyDown: TOnKey; + function Get_OnKeyUp: TOnKey; + function Get_OnChar: TOnChar; + function Get_OnDeadChar: TOnChar; + function Get_OnMouseUp: TOnMouse; + function Get_OnMouseDown: TOnMouse; + function Get_OnMouseMove: TOnMouse; + function Get_OnMouseDblClk: TOnMouse; + function Get_OnMouseWheel: TOnMouse; + function Get_OnMouseEnter: TOnEvent; + function Get_OnMouseLeave: TOnEvent; + function Get_OnTestMouseOver: TOnTestMouseOver; + function Get_OnEndEditLVItem: TOnEditLVItem; + function Get_OnDeleteLVItem: TOnDeleteLVItem; + function Get_OnLVData: TOnLVData; + function Get_OnCompareLVItems: TOnCompareLVItems; + function Get_OnColumnClick: TOnLVColumnClick; + function Get_OnLVStateChange: TOnLVStateChange; + function Get_OnDrawItem: TOnDrawItem; + function Get_OnLVCustomDraw: TOnLVCustomDraw; + function Get_OnTVBeginDrag: TOnTVBeginDrag; + function Get_OnTVBeginEdit: TOnTVBeginEdit; + function Get_OnTVEndEdit: TOnTVEndEdit; + function Get_OnTVExpanding: TOnTVExpanding; + function Get_OnTVExpanded: TOnTVExpanded; + function Get_OnTVDelete: TOnTVDelete; + function Get_OnTVSelChanging: TOnTVSelChanging; + function Get_OnDTPUserString: TDTParseInputEvent; + function Get_OnSBBeforeScroll: TOnSBBeforeScroll; + function Get_OnSBScroll: TOnSBScroll; + function Get_OnScroll: TOnScroll; + function Get_OnDropFiles: TOnDropFiles; + public + procedure Set_TOnEvent(const Index: Integer; const Value: TOnEvent); + procedure Set_OnMessage(const Value: TOnMessage); + procedure Set_OnHelp(const Value: TOnHelp); + procedure Set_OnBitBtnDraw(const Value: TOnBitBtnDraw); + procedure Set_OnPrePaint(const Value: TOnPaint); + procedure Set_OnPostPaint(const Value: TOnPaint); + procedure Set_OnEraseBkgnd(const Value: TOnPaint); + procedure Set_OnSplit(const Value: TOnSplit); + procedure Set_OnCompareLVItems(const Value: TOnCompareLVItems); + procedure Set_OnTVBeginDrag(const Value: TOnTVBeginDrag); + procedure Set_OnTVBeginEdit(const Value: TOnTVBeginEdit); + procedure Set_OnTVEndEdit(const Value: TOnTVEndEdit); + procedure Set_OnTVExpanding(const Value: TOnTVExpanding); + procedure Set_OnTVExpanded(const Value: TOnTVExpanded); + procedure Set_OnTVSelChanging(const Value: TOnTVSelChanging); + procedure Set_OnDTPUserString(const Value: TDTParseInputEvent); + procedure Set_OnSBBeforeScroll(const Value: TOnSBBeforeScroll); + procedure Set_OnSBScroll(const Value: TOnSBScroll); + {$ENDIF EVENTS_DYNAMIC} + protected + procedure SetTBAutoSizeButtons(const Value: Boolean); + function GetTBAutoSizeButtons: Boolean; + function GetTVEditing: Boolean; + function GetDroppedDown: Boolean; + {$IFDEF USE_FLAGS} + function Get_Dragging: Boolean; + function GetTabStop: Boolean; + procedure SetTabStop(const Value: Boolean); + function GetWordWrap: Boolean; + procedure SetWordWrap(const Value: Boolean); + function GetCannotDoubleBuf: Boolean; + procedure SetCannotDoubleBuf(const Value: Boolean); + function GetDoubleBuffered: Boolean; + function GetTransparent: Boolean; + function GetIsForm: Boolean; + function GetSizeGrip: Boolean; + procedure SetSizeGrip(const Value: Boolean); + function GetIsApplet: Boolean; + function GetIsControl: Boolean; + function GetIsMDIChild: Boolean; + function GetCreateVisible: Boolean; + procedure SetCreateVisible(const Value: Boolean); + function GetIsButton: Boolean; + function GetFlat: Boolean; + function GetMouseInCtl: Boolean; + function GetEraseBackground: Boolean; + procedure SetEraseBackground(const Value: Boolean); + function Get3ButtonPress: Boolean; + function GetKeyPreview: Boolean; + procedure SetKeyPreview(const Value: Boolean); + function GetIgnoreDefault: Boolean; + procedure SetIgnoreDefault(const Value: Boolean); + function GetWindowed: Boolean; + procedure SetWindowed(const Value: Boolean); + function Get_RightClick: Boolean; + function Get_SizeRedraw: Boolean; + procedure Set_SizeRedraw(const Value: Boolean); + {$ENDIF USE_FLAGS} + public //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + FormString: KOLString; + {* строка текущего параметра. Очищается после каждого вызова + FormExecuteCommands, так что специальная очистка не требуется. } + function FormGetIntParam: Integer; + {* извлекает очередной целочисленный параметр до ',' или до ';' } + function FormGetColorParam: Integer; + {* извлекает очередной целочисленный параметр до ',' или до ';' } + procedure FormGetStrParam; + {* извлекает очередной строковый параметр до ',' или до ';' -> FormString } + procedure FormCreateParameters( alphabet: PFormInitFuncArray; params: PAnsiChar ); + {* задает первоначальный алфавит и параметры с командами } + procedure FormExecuteCommands(AForm: PControl; ControlPtrOffsets: PSmallIntArray); + {* выполняет команды (с параметрами) до конца или до ';' } {$IFDEF GDI} protected - fSBMinMax: TPoint; - fSBPageSize: Integer; - fSBPosition: Integer; - procedure SetSBMax(Value: Longint); - procedure SetSBMin(Value: Longint); - procedure SetSBPageSize(Value: Integer); - procedure SetSBPosition(Value: Integer); - procedure SetSBMinMax(const Value: TPoint); - function GetDate: TDateTime; function GetTime: TDateTime; procedure SetDate(const Value: TDateTime); @@ -4345,17 +4883,17 @@ type {$IFDEF GDI} function GetHelpPath: KOLString; procedure SetHelpPath(const Value: KOLString); + public procedure SetOnQueryEndSession(const Value: TOnEventAccept); procedure SetOnMinMaxRestore(const Index: Integer; const Value: TOnEvent); procedure SetOnMinimize( const Value: TOnEvent ); procedure SetOnMaximize( const Value: TOnEvent ); procedure SetOnRestore( const Value: TOnEvent ); - procedure SetConstraint(const Index, Value: Integer); - {$IFDEF F_P} + procedure SetOnScroll(const Value: TOnScroll); + protected + procedure SetConstraint(const Index: Integer; Value: SmallInt); function GetOnMinMaxRestore(const Index: Integer): TOnEvent; function GetConstraint(const Index: Integer): Integer; - {$ENDIF F_P} - procedure SetOnScroll(const Value: TOnScroll); function GetLVColalign(Idx: Integer): TTextAlign; procedure SetLVColalign(Idx: Integer; const Value: TTextAlign); @@ -4382,7 +4920,8 @@ type procedure SetClientHeight(const Value: Integer); procedure SetClientWidth(const Value: Integer); function GetHasBorder: Boolean; - procedure SetHasBorder(const Value: Boolean); + public procedure SetHasBorder(const Value: Boolean); + protected function GetHasCaption: Boolean; procedure SetHasCaption(const Value: Boolean); @@ -4391,7 +4930,8 @@ type procedure SetCanResize( const Value: Boolean ); function GetStayOnTop: Boolean; - procedure SetStayOnTop(const Value: Boolean); + public procedure SetStayOnTop(const Value: Boolean); + protected function GetChecked: Boolean; procedure Set_Checked(const Value: Boolean); @@ -4410,35 +4950,40 @@ type function GetItemSelected(ItemIdx: Integer): Boolean; procedure SetItemSelected(ItemIdx: Integer; const Value: Boolean); - procedure SetCtl3D(const Value: Boolean); + public procedure SetCtl3D(const Value: Boolean); + protected function GetCurIndex: Integer; procedure SetCurIndex(const Value: Integer); {$ENDIF GDI} function GetTextAlign: TTextAlign; - procedure SetTextAlign(const Value: TTextAlign); + public procedure SetTextAlign(const Value: TTextAlign); + protected function GetVerticalAlign: TVerticalAlign; - procedure SetVerticalAlign(const Value: TVerticalAlign); + public procedure SetVerticalAlign(const Value: TVerticalAlign); + protected function GetCanvas: PCanvas; {$IFDEF _X_} {$IFDEF GTK} protected - fInBkPaint: Boolean; - fSetTextAlign: procedure( Self_: PControl ); - function ProvideCanvasHandle( Sender: PCanvas ): HDC; + {} fInBkPaint: Boolean; + {} fSetTextAlign: PROCEDURE( Self_: PControl ); + FUNCTION ProvideCanvasHandle( Sender: PCanvas ): HDC; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF GDI} function Dc2Canvas( Sender: PCanvas ): HDC; procedure SetShadowDeep(const Value: Integer); - procedure SetDoubleBuffered(const Value: Boolean); + public procedure SetDoubleBuffered(const Value: Boolean); + protected - procedure SetStatusText(Index: Integer; Value: PKOLChar); - function GetStatusText( Index: Integer ): PKOLChar; + procedure SetStatusText(Index: Integer; const Value: KOLString); + function GetStatusText( Index: Integer ): KOLString; function GetStatusPanelX(Idx: Integer): Integer; procedure SetStatusPanelX(Idx: Integer; const Value: Integer); - procedure SetTransparent(const Value: Boolean); + public procedure SetTransparent(const Value: Boolean); + protected function GetImgListIdx(const Index: Integer): PImageList; procedure SetImgListIdx(const Index: Integer; const Value: PImageList); @@ -4493,10 +5038,12 @@ type procedure TBFreeTBevents; function TBGetButtonLParam(const Idx: Integer): DWORD; procedure TBSetButtonLParam(const Idx: Integer; const Value: DWORD); + public procedure Set_Align(const Value: TControlAlign); + protected function GetSelection: KOLString; procedure SetSelection(const Value: KOLString); - procedure SetTabOrder(const Value: Integer); + procedure SetTabOrder(const Value: SmallInt); function GetFocused: Boolean; procedure SetFocused(const Value: Boolean); {$IFNDEF NOT_USE_RICHEDIT} @@ -4512,8 +5059,7 @@ type function REGetFontSizeValid: Boolean; function REGetCharformat: TCharFormat; procedure RESetCharFormat(const Value: TCharFormat); - function REReadText(Format: TRETextFormat; - SelectionOnly: Boolean): KOLString; + function REReadText(Format: TRETextFormat; SelectionOnly: Boolean): KOLString; procedure REWriteText(Format: TRETextFormat; SelectionOnly: Boolean; const Value: KOLString); function REGetFontName: KOLString; @@ -4533,19 +5079,13 @@ type procedure RESetTextAlign(const Value: TRichTextAlign); function REGetStartIndentValid: Boolean; function REGetAutoURLDetect: Boolean; - procedure RESetAutoURLDetect(const Value: Boolean); + public procedure RESetAutoURLDetect(const Value: Boolean); + protected procedure RESetZoom( const Value: TSmallPoint ); function REGetZoom: TSmallPoint; function GetMaxTextSize: DWORD; procedure SetMaxTextSize(const Value: DWORD); - {$ENDIF NOT_USE_RICHEDIT} - - procedure SetOnResize(const Value: TOnEvent); - - procedure DoSelChange; - - {$IFNDEF NOT_USE_RICHEDIT} function REGetUnderlineEx: TRichUnderline; procedure RESetUnderlineEx(const Value: TRichUnderline); @@ -4574,21 +5114,23 @@ type procedure RESetOverwrite(const Value: Boolean); procedure RESetOvrDisable(const Value: Boolean); function REGetTransparent: Boolean; - procedure RESetTransparent(const Value: Boolean); + public procedure RESetTransparent(const Value: Boolean); + protected procedure RESetOnURL(const Index: Integer; const Value: TOnEvent); procedure SetOnRE_URLClick( const Value: TOnEvent ); procedure SetOnRE_OverURL( const Value: TOnEvent ); - {$IFDEF F_P} function REGetOnURL(const Index: Integer): TOnEvent; - {$ENDIF F_P} function REGetLangOptions(const Index: Integer): Boolean; procedure RESetLangOptions(const Index: Integer; const Value: Boolean); {$ENDIF NOT_USE_RICHEDIT} + procedure SetOnResize(const Value: TOnEvent); + procedure DoSelChange; function LVGetItemImgIdx(Idx: Integer): Integer; procedure LVSetItemImgIdx(Idx: Integer; const Value: Integer); - procedure SetFlat(const Value: Boolean); + public procedure SetFlat(const Value: Boolean); procedure SetOnMouseEnter(const Value: TOnEvent); procedure SetOnMouseLeave(const Value: TOnEvent); + protected procedure EdSetTransparent(const Value: Boolean); procedure SetOnTestMouseOver(const Value: TOnTestMouseOver); function GetPages(Idx: Integer): PControl; @@ -4616,9 +5158,7 @@ type function TV_GetItemChildCount(Item: THandle): Integer; function TVGetItemData(Item: THandle): Pointer; procedure TVSetItemData(Item: THandle; const Value: Pointer); - function GetToBeVisible: Boolean; - procedure SetAlphaBlend(const Value: Byte); procedure SetMaxProgress(const Index, Value: Integer); procedure SetDroppedWidth(const Value: Integer); @@ -4650,7 +5190,7 @@ type procedure SetOnDropFiles(const Value: TOnDropFiles); procedure SetOnHide(const Value: TOnEvent); procedure SetOnShow(const Value: TOnEvent); - procedure SetClientMargin(const Index, Value: Integer); + procedure SetClientMargin(const Index: Integer; Value: ShortInt); {$IFDEF F_P} function GetClientMargin(const Index: Integer): Integer; {$ENDIF F_P} @@ -4658,26 +5198,29 @@ type protected {$IFDEF _X_} {$IFDEF GTK} - fExposeEvent: Integer; + {} fExposeEvent: Integer; {$ENDIF GTK} {$ENDIF _X_} procedure SetOnPaint(const Value: TOnPaint); {$IFDEF GDI} procedure SetOnEraseBkgnd(const Value: TOnPaint); - procedure SetTVRightClickSelect(const Value: Boolean); + public procedure SetTVRightClickSelect(const Value: Boolean); + protected procedure SetOnLVStateChange(const Value: TOnLVStateChange); procedure SetOnMove(const Value: TOnEvent); procedure SetOnMoving(const Value: TOnEventMoving); procedure SetColor1(const Value: TColor); procedure SetColor2(const Value: TColor); procedure SetGradientLayout(const Value: TGradientLayout); - procedure SetGradientStyle(const Value: TGradientStyle); + public procedure SetGradientStyle(const Value: TGradientStyle); + protected procedure SetDroppedDown(const Value: Boolean); function get_ClassName: KOLString; procedure set_ClassName(const Value: KOLString); procedure SetClsStyle( Value: DWord ); {$IFDEF GRAPHCTL_XPSTYLES} + function GetEdgeStyle: TEdgeStyle; procedure SetEdgeStyle( Value: TEdgeStyle ); {$ENDIF} @@ -4691,24 +5234,21 @@ type {$ENDIF GDI} protected {$IFDEF _X_} - fGetCaption: TGetCaption; - fSetCaption: TSetCaption; + {} fGetCaption: TGetCaption; + {} fSetCaption: TSetCaption; {$ENDIF _X_} function GetCaption: KOLString; procedure SetCaption( const Value: KOLString ); {$IFDEF GDI} - procedure SetWindowState( Value: TWindowState ); + public procedure SetWindowState( Value: TWindowState ); + protected function GetWindowState: TWindowState; - - {$ENDIF GDI} - procedure ApplyFont2Wnd; - {$IFDEF GDI} procedure DoClick; - function TBAddInsButtons( Idx: Integer; const Buttons: array of PKOLChar; const BtnImgIdxArray: array of Integer ): Integer; stdcall; - procedure SetBitBtnDrawMnemonic(const Value: Boolean); + public procedure SetBitBtnDrawMnemonic(const Value: Boolean); + protected function GetBitBtnImgIdx: Integer; procedure SetBitBtnImgIdx(const Value: Integer); function GetBitBtnImageList: THandle; @@ -4724,101 +5264,146 @@ type {$IFDEF GDI} fHandle: HWnd; {$ELSE} - {$IFDEF GTK} fHandle: PGtkWidget; - fCaptionHandle: PGtkWidget; - fEventboxHandle: PGtkWidget; - fGetClientArea: TGetClientArea; - fClient: PGtkWidget; - fChildPut: TChildSetPos; - fChildSetPos: TChildSetPos; + {$IFDEF GTK} {} fHandle: PGtkWidget; + {} fCaptionHandle: PGtkWidget; + {} fEventboxHandle: PGtkWidget; + {} fGetClientArea: TGetClientArea; + {} fClient: PGtkWidget; + {} fChildPut: TChildSetPos; + {} fChildSetPos: TChildSetPos; {$ENDIF} {$IFDEF Q_T} fHandle: sometypehere ; {$ENDIF} {$ENDIF} {$IFDEF GDI} - fFocusHandle: HWnd; fClsStyle: DWord; - fStyle: DWord; + fStyle: TStyle; fExStyle: DWord; - fCursor: HCursor; - fCursorShared: Boolean; - fIcon: HIcon; - fIconShared: Boolean; {$ENDIF GDI} - fIgnoreWndCaption: Boolean; {$IFDEF GDI} - -{$IFDEF GRAPHCTL_XPSTYLES} - fEdgeStyle : TEdgeStyle; -{$ENDIF} - - fWindowState: TWindowState; - //fShowAction: Integer; fDefWndProc: Pointer; - fNCDestroyed: Boolean; - {$ENDIF GDI} FParent: PControl; - FParentWnd: HWnd; //<<-- ++ for InitOrthaned !! - fEnabled: Boolean; // Caution!!! fVisible must follow fEnabled! ___ - fVisible: Boolean; //____________________________________________// - fTabstop: Boolean; - fTabOrder: Integer; + + {$IFDEF USE_FLAGS} //................... less memory usage with USE_FLAGS .. + fFlagsG1: T1Flags; + fFlagsG2: T2Flags; + fFlagsG3: T3Flags; + fFlagsG4: T4Flags; + fFlagsG5: T5Flags; + fFlagsG6: T6Flags; + {$ELSE} //.................................................................. + {} fEnabled: Boolean; // Caution!!! fVisible must follow fEnabled! ___ + {} fVisible: Boolean; //____________________________________________// + {} fTabstop: Boolean; + {} fWordWrap: Boolean; + {} fPreventResize: Boolean; + // fCursorShared: Boolean; + {} fIconShared: Boolean; + {} fIgnoreWndCaption: Boolean; + {} fSizeRedraw: Boolean; {YS} + {} fIsStaticControl: Byte; + {} fCannotDoubleBuf: Boolean; + {} fDoubleBuffered: Boolean; + {* True, if cannot set DoubleBuffered to True (RichEdit). } + {* True, if it is static control with a caption. (Mainly, to prevent + flicks in DoubleBuffered mode. } + {} fTransparent: Boolean; + {} fClassicTransparent : Boolean; + // FCreating: Boolean; + {* True, when creating of object is in progress. } + {} fDestroying: Boolean; + {* True, when destroying of the window is started. } + {} fBeginDestroying: Boolean; + {* true, when destroying of the window is initiated by the system, i.e. + message WM_DESTROY fired } + {} fChangedPosSz: Byte; + {* Flags of changing left (1), top (2), width (4) or height (8) } + {} fIsForm: Boolean; + {* True, if the object is form. } + {} fSizeGrip: Boolean; + {} fIsApplet: Boolean; + {* True, if the object represent application taskbar button. } + {} fIsControl: Boolean; + {* True, if it is a control on form. } + {} fIsMDIChild: Boolean; + {* TRUE, if the object is MDI child form. } + {} fCreateHidden: Boolean; + {} fVisibleWoParent: Boolean; + {} fNotUseAlign: Boolean; + {} fNotUpdate: Boolean; + {} fCreateVisible: Boolean; + {} fIsButton: Boolean; + {} fIsBitBtn: Boolean; + {} fIsGroupBox: Boolean; + {} fIsSplitter: Boolean; + {} fIsCommonControl: Boolean; + {* True, if it is common control. } + {} fFlat: Boolean; + {} fMouseInControl: Boolean; + {} fChecked: Boolean; + {} fPushed: Boolean; + {} fHot: Boolean; + {} fFocused: Boolean; + {} fPressed : Boolean; + // fDropped: Boolean; + {} f3ButtonPress: Boolean; + // fEditing: Boolean; + {} fEraseUpdRgn: Boolean; + {} fKeyPreview: Boolean; + {} fKeyPreviewing: Boolean; + {} fIgnoreDefault: Boolean; + {} fAllBtnReturnClick: Boolean; + {} fDefaultBtn: Boolean; + {} fCancelBtn: Boolean; + {} fWindowed: Boolean; // + {* True, if control is windowed (or is a form). It is set to FALSE only for + graphic controls. } + {} fCtlClsNameChg: Boolean; // + {* True, if control class name changed and memory is allocated to store it. } // + {} fRightClick: Boolean; + {} fDragging: Boolean; + {$ENDIF not USE_FLAGS} //................................................................. fTextAlign: TTextAlign; fVerticalAlign: TVerticalAlign; - fWordWrap: Boolean; - fPreventResize: Boolean; - {$IFDEF GDI} + {$IFDEF STORE_EDGESTYLE} + {} fEdgeStyle : TEdgeStyle; + {$ENDIF} + fLookTabKeys: TTabKeys; + fTabOrder: SmallInt; fAlphaBlend: Byte; - {$ENDIF GDI} - FDroppedWidth: Integer; // Caution!!! order of following 5 fields is important!!! fDynHandlers: PList; fChildren: PList; {* List of children. } - fTBttCmd: PList; - fTBttTxt: {$IFDEF UNICODE_CTRLS} PWStrList {$ELSE} PStrList {$ENDIF}; - {$IFDEF GDI} - fTmpFont: PGraphicTool; - {$ENDIF GDI} //________________________________________________________// {$IFDEF GDI} - fMDIClient: PControl; - {* MDI client window control } - fMDIChildren: PList; - {* List of MDI children. It is filled for MDI client window. } - fWndFunc: Pointer; - {* Initially pointer to WndFunc. For MDI child window, points to DefMDIChildProc. } - fExMsgProc: function( Applet: PControl; var Msg: TMsg ): Boolean; - {* Additional message handler called directly from Applet.ProcessMessage. - Used to call TranslateMDISysAccel API function for MDI application. } - fMDIDestroying: Boolean; - {* } - fTmpBrush: HBrush; {* Brush handle to return in response to some color set messages. Intended for internal use instead of Brush.Color if possible to avoid using it. } - fTmpBrushColorRGB: TColor; + {$IFDEF STORE_fTmpBrushColorRGB} + {} fTmpBrushColorRGB: TColor; + {$ENDIF} { } - fMembersCount: Integer; - {* Memebers count is first used in XCustomControl to separate - some internal child controls from common XControl.Children - and make it invisible among Children[]. } - fDrawCtrl1st: PControl; - {* Child control to draw it first, i.e. foreground of others. } - FCreating: Boolean; - {* True, when creating of object is in progress. } - fDestroying: Boolean; - {* True, when destroying of the window is started. } - fBeginDestroying: Boolean; - {* true, when destroying of the window is initiated by the system, i.e. - message WM_DESTROY fired } - fNestedMsgHandling: Integer; - {* level of nested message handling for a control. Only when it is 0 at - the end of message handling and fBeginDestroying set, the control is - destroyed. } + public + {$IFDEF COMMANDACTIONS_OBJ} + fCommandActions: PCommandActionsObj; + {$ELSE} + fCommandActions: TCommandActions; + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + EV: PEvents; + protected + function ProvideUniqueEvents: PEvents; + procedure FreeEV; + {$ELSE} + protected + EV: TEvents; + {$ENDIF} + protected + PP: TProcedures; fMenu: HMenu; {* Usually used to store handle of attached main menu, but sometimes is used to store control ID (for standard GUI controls only). } @@ -4844,338 +5429,106 @@ type {* Pointer to first private image list. Control can own several image, lists, linked to a chain of image list objects. All these image lists are released automatically, when control is destroyed. } - fCtlImageListSml: PImageList; - {* ImageList object (with small icons 16x16) to use with a control (e.g., - with ListView control). - If not set, but control has a list of image list objects, last added - image list with small icons is used automatically. } - fCtlImageListNormal: PImageList; - {* ImageList object (with big icons 32x32) to use with a control. - If not set, last added image list with big icons is used. } - fCtlImgListState: PImageList; - {* ImageList object to use as a state image list (for ListView control). } {$ENDIF GDI} - fIsApplet: Boolean; - {* True, if the object represent application taskbar button. } - fIsForm: Boolean; - {* True, if the object is form. } - fIsButton: Boolean; {$IFDEF GDI} - fSizeGrip: Boolean; - {$ENDIF GDI} - fIsMDIChild: Boolean; - {* TRUE, if the object is MDI child form. } - fIsControl: Boolean; - {* True, if it is a control on form. } - fIsStaticControl: Byte; - {* True, if it is static control with a caption. (To prevent flickering - it in DoubleBuffered mode. } - {$IFDEF GDI} - fIsCommonControl: Boolean; - {* True, if it is common control. } - {$ENDIF GDI} - fChangedPosSz: Byte; - {* Flags of changing left (1), top (2), width (4) or height (8) } - {$IFDEF GDI} - fCannotDoubleBuf: Boolean; - {* True, if cannot set DoubleBuffered to True (RichEdit). } fUpdRgn: HRgn; - fCollectUpdRgn: HRGN; - fEraseUpdRgn: Boolean; + //fCollectUpdRgn: HRGN; fPaintDC: HDC; {$ENDIF GDI} - fLookTabKeys: TTabKeys; - {$IFDEF GDI} - fNotUpdate: Boolean; - fColumn: Integer; - FSupressTab: Boolean; - fUpdateCount: Integer; - fPaintLater: Boolean; - fOnLeave: TOnEvent; - fEditing: Boolean; + protected fAutoPopupMenu: PObj; - fHelpContext: Integer; - {$IFDEF USE_GRAPHCTLS} - fDoInvalidate: procedure of object; - {$ENDIF} + //fHelpContext: Integer; {$IFDEF GTK} fDeltaX, fDeltaY: Integer; {$ENDIF GTK} // Order of following fields is important: //_______________________________________________________________________________________________ - fPass2DefProc: function( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; - fOnDynHandlers: TWindowFunc; // - fWndProcKeybd: function( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; // - fControlClick: procedure( Sender : PObj ); // - {$ENDIF GDI} - fAutoSize: procedure( Self_: PObj ); - fControlClassName: PKOLChar; // + //{$ENDIF GDI} {$IFDEF GDI} - fWindowed: Boolean; // - {* True, if control is windowed (or is a form). It is set to FALSE only for - graphic controls. } // // - fCtlClsNameChg: Boolean; // - {* True, if control class name changed and memory is allocated to store it. } // - fWndProcResizeFlicks: function( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; // - {$ENDIF GDI} - fGotoControl: function( Self_: PControl; Key: DWORD; CheckOnly: Boolean ): Boolean; // - {$IFDEF GDI} - fCtl3Dchild: Boolean; // - fCtl3D: Boolean; // {$ENDIF GDI} fTextColor: TColor; // - fColor: TColor; // {* Color of text. Used instead of fFont.Color internally to // avoid usage of Font object if user is not accessing and changing it. } // + fColor: TColor; // + {* Color of control background. } // fFont: PGraphicTool; // fBrush: PGraphicTool; // - fCanvas: PCanvas; - {* Color of control background. } // - fMargin: Integer; // - fBoundsRect: TRect; // - fClientTop, fClientBottom, fClientLeft, fClientRight: Integer; // + fMargin: ShortInt; // + fClientTop: ShortInt; + fClientBottom: ShortInt; + fClientLeft: ShortInt; + fClientRight: ShortInt; // {* Store adjustment factor of ClientRect for some 'idiosincrasies' windows, // such as Groupbox or Tabcontrol. } // + fCtl3D_child: Byte; // + fBoundsRect: TRect; // + fCursor: HCursor; //_____________________________________________________________________________________________// // this is the end of fiels set, which order is important + fCanvas: PCanvas; {$IFDEF GDI} - - fDoubleBuffered: Boolean; - fTransparent: Boolean; -{$IFDEF GRAPHCTL_XPSTYLES} - fClassicTransparent : Boolean; -{$ENDIF} - fRETransparent: Boolean; - fParentRequirePaint: Boolean; - fSelfRequirePaint: Boolean; fDblExcludeRgn: HDC; - fOnMessage: TOnMessage; - fOldOnMessage: TOnMessage; - {$ENDIF GDI} - fOnClick: TOnEvent; - fClickedEvent: Integer; - {$IFDEF _X_} + {$IFDEF GTK} + {} fClickedEvent: Integer; + {$ENDIF} + public procedure SetOnClick( const Value: TOnEvent ); - {$ENDIF _X_} protected {$IFDEF GDI} - fRightClick: Boolean; - fCurrentControl: PControl; - fCreateVisible, fCreateHidden: Boolean; - fRadio1st, fRadioLast : THandle; - fDropDownProc: procedure( Sender : PObj ); - fDropped: Boolean; - fCurIdxAtDrop: Integer; - fPrevWndProc: Pointer; - fClickDisabled: Byte; - fCurItem, fCurIndex: Integer; - FOnScroll: TOnScroll; - FScrollLineDist: array[ 0..1 ] of Integer; + //fRadio1st: THandle; + //fRadioLast : THandle; + //fDropDownProc: procedure( Sender : PObj ); + //fPrevWndProc: Pointer; - fDefaultBtn: Boolean; - fCancelBtn: Boolean; - fDefaultBtnCtl: PControl; - fCancelBtnCtl: PControl; - fAllBtnReturnClick: Boolean; - fIgnoreDefault: Boolean; + fCurIndex: Integer; - {$ENDIF GDI} - fOnMouseDown: TOnMouse; // CAUTION!!! Order of mouse event handlers is important. ____ - fOnMouseUp: TOnMouse; // - fOnMouseMove: TOnMouse; // - fOnMouseDblClk: TOnMouse; // - fOnMouseWheel: TOnMouse; //_____________________________________________________// - f3ButtonPress: Boolean; - {$IFDEF GDI} - - fOldDefWndProc: Pointer; - - fOnChange: TOnEvent; - fOnEnter: TOnEvent; - - FOnLVCustomDraw: TOnLVCustomDraw; - FOnSBBeforeScroll: TOnSBBeforeScroll; - FOnSBScroll: TOnSBScroll; + //fOldDefWndProc: Pointer; + procedure SetSBMax(Value: Longint); + procedure SetSBMin(Value: Longint); + procedure SetSBPageSize(Value: Integer); + procedure SetSBPosition(Value: Integer); + procedure SetSBMinMax(const Value: TPoint); protected procedure SetOnLVCustomDraw(const Value: TOnLVCustomDraw); - public - fCommandActions: TCommandActions; {$ENDIF GDI} protected {$IFDEF GDI} - fOnChar: TOnChar; - {$IFDEF SUPPORT_ONDEADCHAR} - fOnDeadChar: TOnChar; - {$ENDIF SUPPORT_ONDEADCHAR} - fOnKeyUp: TOnKey; - fOnKeyDown: TOnKey; + //fPaintMsg: TMsg; {$ENDIF GDI} - fOnPaint: TOnPaint; + FMaxWidth: SmallInt; + FMinWidth: SmallInt; + FMaxHeight: SmallInt; + FMinHeight: SmallInt; {$IFDEF GDI} - fOnPaint2: TOnPaint; - fPaintMsg: TMsg; - fOnPrepaint: TOnPaint; - fOnPostPaint: TOnPaint; - fPaintProc: TPaintProc; - - {$ENDIF GDI} - FMaxWidth: Integer; - FMinWidth: Integer; - FMaxHeight: Integer; - FMinHeight: Integer; - {$IFDEF GDI} - fShadowDeep: Integer; fStatusCtl: PControl; - fStatusWnd: HWnd; - fColor1: TColor; - fColor2: TColor; - fLVColCount: Integer; - fLVOptions: TListViewOptions; - fLVStyle: TListViewStyle; - fOnEndEditLVITem: TOnEditLVItem; - fLVTextBkColor: TColor; - fLVItemHeight: Integer; - - fOnDropDown: TOnEvent; - fOnCloseUp: TOnEvent; - - fModalResult: Integer; - - fModal: Integer; - fModalForm: PControl; - + //fStatusTxt: PKOLChar; {$ENDIF GDI} - fAlign: TControlAlign; - fAligning:TAlignings; - fNotUseAlign: Boolean; {$IFDEF GDI} - fDragCallback: TOnDrag; - fDragging, fInDoDrag: Boolean; - fDragStartPos: TPoint; - fMouseStartPos: TPoint; - fSplitStartPos: TPoint; - fSplitStartPos2: TPoint; - fSplitStartSize: Integer; - fSplitMinSize1, fSplitMinSize2: Integer; - fOnSplit: TOnSplit; - fSecondControl: PControl; - fOnSelChange: TOnEvent; - - {$IFNDEF NOT_USE_RICHEDIT} - fRECharFormatRec: TCharFormat; - fREError: Integer; - fREStream: PStream; - fREStrLoadLen: DWORD; - fREParaFmtRec: TParaFormat2; - {$ENDIF NOT_USE_RICHEDIT} - FOnResize: TOnEvent; - fOnProgress: TOnEvent; - fCharFmtDeltaSz: Integer; - fParaFmtDeltaSz: Integer; - fREOvr: Boolean; - fReOvrDisable: Boolean; - fOnREInsModeChg: TOnEvent; - fREScrolling: Boolean; - fUpdCount: Integer; - fOnREOverURL: TOnEvent; - fOnREURLClick: TOnEvent; - fRECharArea: TRichFmtArea; - fBitBtnOptions : TBitBtnOptions; - fGlyphLayout : TGlyphLayout; - fGlyphBitmap : HBitmap; - fGlyphCount : Integer; - fGlyphWidth, fGlyphHeight: Integer; - fOnBitBtnDraw: TOnBitBtnDraw; - fFlat: Boolean; - fSizeRedraw: Boolean; {YS} - - fOnMouseLeave: TOnEvent; - fOnMouseEnter: TOnEvent; - fOnTestMouseOver: TOnTestMouseOver; - - fMouseInControl: Boolean; - fRepeatInterval: Integer; - fChecked: Boolean; - fPushed: Boolean; - fPrevFocusWnd: HWnd; - - fOnTVBeginDrag: TOnTVBeginDrag; - fOnTVBeginEdit: TOnTVBeginEdit; - fOnTVEndEdit: TOnTVEndEdit; - fOnTVExpanded: TOnTVExpanded; - fOnTVExpanding: TOnTVExpanding; - fOnTVDelete: TOnTVDelete; - - fOnDeleteLVItem: TOnDeleteLVItem; - fOnDeleteAllLVItems: TOnEvent; - fOnLVData: TOnLVData; - fOnCompareLVItems: TOnCompareLVItems; - fOnColumnClick: TOnLVColumnClick; - fOnDrawItem: TOnDrawItem; - fOnMeasureItem: TOnMeasureItem; - fREUrl: KOLString; - FMinimizeWnd: PControl; - FFixWidth: Integer; - FFixHeight: Integer; - FOnDropFiles: TOnDropFiles; - FOnHide: TOnEvent; - FOnShow: TOnEvent; - fOnEraseBkgnd: TOnPaint; + //fDragStartPos: TSmallPoint; + //fMouseStartPos: TSmallPoint; + {$IFDEF FIX_WIDTH_HEIGHT} + {} FFixWidth: Integer; + {} FFixHeight: Integer; + {$ENDIF} {$ENDIF GDI} - //----- order of following 3 events important: // + //----- order of following 3 fields important: // fCaption: KOLString; fCustomData: Pointer; + fControlClassName: PKOLChar; // {$IFDEF GDI} - fStatusTxt: PKOLChar; //---------------------------------------------// fCustomObj: PObj; - fOnTVSelChanging: TOnTVSelChanging; - - fOnClose: TOnEventAccept; - fOnQueryEndSession: TOnEventAccept; - fCloseQueryReason: TCloseQueryReason; - - fShowAction: DWORD; - //----- order of following 3 events important: // - fOnMinimize: TOnEvent; // - fOnMaximize: TOnEvent; // - fOnRestore: TOnEvent; // - //---------------------------------------------// - + public + DF: TDataFields; + {* Data fields for certain controls. These are overlapped to + economy size of TControl object. } //fCreateParamsExt: procedure( Self_: PControl; var Params: TCreateParams ); - fCreateWndExt: procedure( Sender: PControl ); - - fTBevents: PList; // events for TBAssignEvents - fTBBtnImgWidth: Integer; // custom toolbar bitmap width - FTBBtMinWidth: Integer; - FTBBtMaxWidth: Integer; - fGradientStyle: TGradientStyle; - fGradientLayout: TGradientLayout; - fVisibleWoParent: Boolean; - - fTVRightClickSelect: Boolean; - FOnMove: TOnEvent; - FOnMoving: TOnEventMoving; - FOnLVStateChange: TOnLVStateChange; - fNotAvailable: Boolean; - FPressedMnemonic: DWORD; - FBitBtnDrawMnemonic: Boolean; - FBitBtnGetCaption: function( Self_: PControl; const S: KOLString ): KOLString; - FBitBtnExtDraw: procedure( Self_: PControl; DC: HDC; X, Y: Integer; const R: TRect; - const CapText, CapTxtOrig: KOLString; Color: TColor ); - FTextShiftX, FTextShiftY: Integer; - fNotifyChild: procedure( Self_, Child: PControl ); - fScrollChildren: procedure( Self_: PControl ); - fOnHelp: TOnHelp; - - FOnDTPUserString: TDTParseInputEvent; - - fOnTBCustomDraw: TOnTBCustomDraw; + protected {$IFDEF USE_MHTOOLTIP} {$DEFINE var} @@ -5189,8 +5542,7 @@ type {$ENDIF GDI} - procedure Init; {-}virtual;{+}{++}(*override;*){--} - {* } //CLASSES //BCB_CLASSES + procedure Init; virtual; {$IFDEF GDI} procedure InitParented( AParent: PControl ); virtual; {* Initialization of visual object. } @@ -5199,8 +5551,8 @@ type {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} - procedure InitParented( AParent: PControl; widget: PGtkWidget; - need_eventbox: Boolean ); virtual; + PROCEDURE InitParented( AParent: PControl; widget: PGtkWidget; + {}need_eventbox: Boolean ); VIRTUAL; {* Initialization of visual object. } {$ENDIF GTK} {$ENDIF _X_} @@ -5254,6 +5606,7 @@ type in overriden method CreateParams after calling of the inherited one. } function UpdateWndStyles: PControl; + public {* Updates fStyle, fExStyle, fClsStyle from window handle } procedure SetOnChar(const Value: TOnChar); {* } @@ -5266,25 +5619,14 @@ type procedure SetOnKeyUp(const Value: TOnKey); {* } {$ENDIF GDI} - procedure SetOnMouseDown(const Value: TOnMouse); - {* } - procedure SetOnMouseMove(const Value: TOnMouse); - {* } - procedure SetOnMouseUp(const Value: TOnMouse); - {* } - procedure SetOnMouseWheel(const Value: TOnMouse); - {* } - procedure SetOnMouseDblClk(const Value: TOnMouse); - {* } {$IFDEF GDI} procedure SetHelpContext( Value: Integer ); {* } procedure SetOnTVDelete( const Value: TOnTVDelete ); {* } - procedure SetDefaultBtn(const Index: Integer; const Value: Boolean); - {$IFDEF F_P} + public procedure SetDefaultBtn(const Index: Integer; const Value: Boolean); + protected function GetDefaultBtn(const Index: Integer): Boolean; - {$ENDIF F_P} function DefaultBtnProc( var Msg: TMsg; var Rslt: Integer ): Boolean; {* } @@ -5294,7 +5636,7 @@ type function GetDateTimeRange: TDateTimeRange; procedure SetDateTimePickerColor( Index: TDateTimePickerColor; Value: TColor ); function GetDateTimePickerColor( Index: TDateTimePickerColor ): TColor; - procedure SetDateTimeFormat( const Value: AnsiString ); + procedure SetDateTimeFormat( const Value: KOLString ); function Get_SystemTime: TSystemTime; procedure Set_SystemTime(const Value: TSystemTime); @@ -5312,13 +5654,13 @@ type {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} - constructor CreateParented( AParent: PControl; widget: PGtkWidget; - need_eventbox: Boolean ); + CONSTRUCTOR CreateParented( AParent: PControl; widget: PGtkWidget; + {}need_eventbox: Boolean ); {* Creates new instance of TControl object, calling InitParented } {$ENDIF GTK} {$ENDIF _X_} {$IFDEF GDI} - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* Destroyes object. First of all, destructors for all children are called. } @@ -5352,26 +5694,13 @@ type {* Obvious. } property ToBeVisible: Boolean read GetToBeVisible; {* Returns True, if a control is supposed to be visible when its - form is showing. Thus is, True is returned if either control - is Visible or hidden, but marked with flag fCreateHidden. } - property CreateVisible: Boolean read fCreateVisible write fCreateVisible; + form is showing. } + property CreateVisible: Boolean + read {$IFDEF USE_FLAGS} GetCreateVisible {$ELSE} fCreateVisible {$ENDIF} + write {$IFDEF USE_FLAGS} SetCreateVisible {$ELSE} fCreateVisible {$ENDIF}; {* False by default. If You want your form to be created visible and flick due creation, set it to True. This does not affect size of executable anyway. } - property Align: TControlAlign read FAlign write Set_Align; - {* Align style of a control. If this property is not used in your - application, there are no additional code added. Aligning of - controls is made in KOL like in VCL. To align controls when - initially create ones, use "transparent" function SetAlign - ("transparent" means that it returns @Self as a result). - |
- Note, that it is better not to align combobox caClient, caLeft or - caRight (better way is to place a panel with Border = 0 and - EdgeStyle = esNone, align it as desired and to place a combobox on it - aligning caTop or caBottom). Otherwise, big problems could be under - Win9x/Me, and some delay could occur under any other systems. - |
Do not attempt to align some kinds of controls (like combobox) - caLeft or caRight, this can cause infinite recursion. } {$ENDIF GDI} property BoundsRect: TRect read GetBoundsRect write SetBoundsRect; {* Bounding rectangle of the visual. Coordinates are relative @@ -5388,22 +5717,22 @@ type property Position: TPoint read GetPosition write Set_Position; {* Represents top left position of the object. See also BoundsRect. } {$IFDEF GDI} - property MinWidth: Integer index 0 + property MinWidth: SmallInt index 0 {$IFDEF F_P} read GetConstraint {$ELSE DELPHI} read FMinWidth {$ENDIF F_P/DELPHI} write SetConstraint; {* Minimal width constraint. } - property MinHeight: Integer index 1 + property MinHeight: SmallInt index 1 {$IFDEF F_P} read GetConstraint {$ELSE DELPHI} read FMinHeight {$ENDIF F_P/DELPHI} write SetConstraint; {* Minimal height constraint. } - property MaxWidth: Integer index 2 + property MaxWidth: SmallInt index 2 {$IFDEF F_P} read GetConstraint {$ELSE DELPHI} read FMaxWidth {$ENDIF F_P/DELPHI} write SetConstraint; {* Maximal width constraint. } - property MaxHeight: Integer index 3 + property MaxHeight: SmallInt index 3 {$IFDEF F_P} read GetConstraint {$ELSE DELPHI} read FMaxHeight {$ENDIF F_P/DELPHI} write SetConstraint; @@ -5436,11 +5765,6 @@ type {* Invalidates rectangle, occupied by the visual (but only if Showing = True). } {$IFDEF GDI} - protected - {$IFDEF USE_GRAPHCTLS} - procedure InvalidateWindowed; - procedure InvalidateNonWindowed; - {$ENDIF} public procedure InvalidateEx; {* Invalidates the window and all its children. } @@ -5459,7 +5783,9 @@ type procedure EndUpdate; {* See BeginUpdate. } - property Windowed: Boolean read fWindowed write fWindowed; + property Windowed: Boolean + read {$IFDEF USE_FLAGS} GetWindowed {$ELSE} fWindowed {$ENDIF} + write {$IFDEF USE_FLAGS} SetWindowed {$ELSE} fWindowed {$ENDIF}; {* Constantly returns True, if object is windowed (i.e. owns correspondent window handle). Otherwise, returns False. |
@@ -5473,30 +5799,15 @@ type function HandleAllocated: Boolean; {* Returns True, if window handle is allocated. Has no sense for non-Windowed objects (but now, the KOL has no non-Windowed controls). } - property MDIClient: PControl read fMDIClient; - {* For MDI forms only: returns MDI client window control, containng all MDI - children. Use this window to send specific messages to rule MDI children. } {$ENDIF GDI} - property ChildCount: Integer read GetChildCount;//GetChildCountWOMembers; - {* Returns number of commonly accessed child objects (without - MembersCount). } + property ChildCount: Integer read GetChildCount; + {* Returns number of commonly accessed child objects. } property Children[ Idx: Integer ]: PControl read GetMembers; {* Child items of TVisual object. Property is reintroduced here to separate access to always visible Children[] from restricted a bit Members[]. } {$IFDEF GDI} - property MembersCount: Integer read FMembersCount; - {* Returns number of "internal" child objects, which are - not accessible through common Children[] property. } - property Members[ Idx: Integer ]: PControl read GetMembers; - {* Members and children array of the object (first from 0 to - MembersCount-1 are Members[], and Children[] are followed by - them. Usually You do not need to use this list. Use instead - Children[0..ChildCount] property, Members[] is intended for - internal needs of XCL (and in KOL by now Members and Children - actually are the same properties). } - procedure PaintBackground( DC: HDC; Rect: PRect ); {* Is called to paint background in given rectangle. This method is filling clipped area of the Rect rectangle with @@ -5515,7 +5826,7 @@ type {* |<#form> Returns parent form for a control (of @Self for form itself. } {$IFDEF GDI} - property ActiveControl: PControl read fCurrentControl write fCurrentControl; + property ActiveControl: PControl read DF.fCurrentControl write DF.fCurrentControl; {* } function Client2Screen( const P: TPoint ): TPoint; {* Converts the client coordinates of a specified point to screen coordinates. } @@ -5596,10 +5907,12 @@ type {$IFDEF GRAPHCTL_XPSTYLES} - property edgeStyle : TEdgeStyle read fEdgeStyle write SetEdgeStyle; + property edgeStyle : TEdgeStyle + read {$IFnDEF STORE_EDGESTYLE} GetEdgeStyle {$ELSE} fEdgeStyle {$ENDIF} + write SetEdgeStyle; {$ENDIF} - property Style: DWord read fStyle write SetStyle; + property Style: DWord read fStyle.Value write SetStyle; {* Window styles. Available styles are: | Creates a window that has a thin-line border. @@ -5755,8 +6068,8 @@ type procedure CursorLoad( Inst: Integer; ResName: PKOLChar ); {* Loads Cursor from the resource. See also comments for Icon property. } - property Icon: HIcon read {$IFDEF SMALLEST_CODE} fIcon {$ELSE} GetIcon {$ENDIF} - write SetIcon; + property Icon: HIcon read {$IFDEF SMALLEST_CODE} DF.fIcon {$ELSE} GetIcon {$ENDIF} + write SetIcon; {* |<#appbutton> |<#form> Icon. By default, icon of the Applet is used. To load icon from the @@ -5776,7 +6089,7 @@ type property Menu: HMenu read fMenu write SetMenu; {* Menu (or ID of control - for standard GUI controls). } - property HelpContext: Integer read fHelpContext write SetHelpContext; + property HelpContext: Integer read GetHelpContext write SetHelpContext; {* Help context. } function AssignHelpContext( Context: Integer ): PControl; {* Assigns HelpContext and returns @ Self (can be used in initialization @@ -5795,7 +6108,9 @@ type WinHelp format help file. If HtmlHelp used, call global procedure AssignHtmlHelp instead. } - property OnHelp: TOnHelp read fOnHelp write fOnHelp; + property OnHelp: TOnHelp + read {$IFDEF EVENTS_DYNAMIC} Get_OnHelp {$ELSE} EV.fOnHelp {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnHelp {$ELSE} EV.fOnHelp {$ENDIF}; {* An event of a form, it is called when F1 pressed or help topic requested by any other way. To prevent showing help, nullify Sender. Set Popup to TRUE to provide showing help in a pop-up window. It is also possible to @@ -5978,23 +6293,27 @@ type |<#combo> Access to user-defined data, associated with the item of a list box and combo box. } - property OnDropDown: TOnEvent read fOnDropDown write fOnDropDown; + property OnDropDown: TOnEvent index idx_FOnDropDown + read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnDropDown {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnDropDown {$ENDIF}; {* |<#combo> |<#toolbar> Is called when combobox is dropped down (or drop-down button of toolbar is pressed - see also OnTBDropDown). } - property OnCloseUp: TOnEvent read fOnCloseUp write fOnCloseUp; + property OnCloseUp: TOnEvent index idx_FOnCloseUp + read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnCloseUp {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnCloseUp {$ENDIF}; {* |<#combo> Is called when combobox is closed up. When drop down list is closed because user pressed "Escape" key, previous selection is restored. To test if it is so, call GetKeyState( VK_ESCAPE ) and check, if negative value is returned (i.e. Escape key is pressed when event handler is calling). } - property DroppedWidth: Integer read FDroppedWidth write SetDroppedWidth; + property DroppedWidth: Integer read DF.FDroppedWidth write SetDroppedWidth; {* |<#combo> Allows to change width of dropped down items list for combobox (only!) control. } - property DroppedDown: Boolean read fDropped write SetDroppedDown; + property DroppedDown: Boolean read GetDroppedDown write SetDroppedDown; {* |<#combo> Dropped down state for combo box. Set it to TRUE or FALSE to change dropped down state. } @@ -6022,22 +6341,24 @@ type Includes system files.
If the listbox is sorted, directory items will be sorted (alpabetically). } - property OnBitBtnDraw: TOnBitBtnDraw read fOnBitBtnDraw write fOnBitBtnDraw; + property OnBitBtnDraw: TOnBitBtnDraw + read {$IFDEF EVENTS_DYNAMIC} Get_OnBitBtnDraw {$ELSE} EV.fOnBitBtnDraw {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnBitBtnDraw {$ELSE} EV.fOnBitBtnDraw {$ENDIF}; {* |<#bitbtn> Special event for BitBtn. Using it, it is possible to provide additional effects, such as highlighting button text (by changing its Font and other properties). If the handler returns True, it is supposed that it made all drawing and there are no further drawing occure. } - property BitBtnDrawMnemonic: Boolean read FBitBtnDrawMnemonic write SetBitBtnDrawMnemonic; + property BitBtnDrawMnemonic: Boolean read DF.fBitBtnDrawMnemonic write SetBitBtnDrawMnemonic; {* |<#bitbtn> Set this property to TRUE to provide correct drawing of bit btn control caption with '&' characters (to remove such characters, and underline follow ones). } - property TextShiftX: Integer read fTextShiftX write fTextShiftX; + property TextShiftX: Integer read DF.fTextShiftX write DF.fTextShiftX; {* |<#bitbtn> Horizontal shift for bitbtn text when the bitbtn is pressed. } - property TextShiftY: Integer read fTextShiftY write fTextShiftY; + property TextShiftY: Integer read DF.fTextShiftY write DF.fTextShiftY; {* |<#bitbtn> Vertical shift for bitbtn text when the bitbtn is pressed. } property BitBtnImgIdx: Integer read GetBitBtnImgIdx write SetBitBtnImgIdx; @@ -6056,7 +6377,9 @@ type {* |<#button> Sets up button icon image and changes its styles. Returns button itself. } - property OnMeasureItem: TOnMeasureItem read fOnMeasureItem write SetOnMeasureItem; + property OnMeasureItem: TOnMeasureItem + read {$IFDEF EVENTS_DYNAMIC} Get_OnMeasureItem {$ELSE} EV.fOnMeasureItem {$ENDIF} + write SetOnMeasureItem; {* |<#combo> |<#listbox> |<#listview> @@ -6069,7 +6392,7 @@ type property DefaultBtn: Boolean index 13 {$IFDEF F_P} read GetDefaultBtn - {$ELSE DELPHI} read fDefaultBtn + {$ELSE DELPHI} read {$IFDEF USE_FLAGS} GetDefaultBtn {$ELSE} fDefaultBtn {$ENDIF} {$ENDIF F_P/DELPHI} write SetDefaultBtn; {* |<#button> |<#bitbtn> @@ -6079,7 +6402,7 @@ type after setting OnMessage event for the form. } property CancelBtn: Boolean index 27 {$IFDEF F_P} read GetDefaultBtn - {$ELSE DELPHI} read fCancelBtn + {$ELSE DELPHI} read {$IFDEF USE_FLAGS} GetDefaultBtn {$ELSE} fCancelBtn {$ENDIF} {$ENDIF F_P/DELPHI} write SetDefaultBtn; {* |<#button> |<#bitbtn> @@ -6088,10 +6411,12 @@ type fOldOnMessage field and calling in chain. So, assign cancel button after setting OnMessage event for the form. } function AllBtnReturnClick: PControl; - {* Call this method for a form or any its control to provide clicking + {* Call this method for a form or control to provide clicking a focused button when ENTER pressed. By default, a button can be clicked only by SPACE key from the keyboard, or by mouse. } - property IgnoreDefault: Boolean read fIgnoreDefault write fIgnoreDefault; + property IgnoreDefault: Boolean + read {$IFDEF USE_FLAGS} GetIgnoreDefault {$ELSE} fIgnoreDefault {$ENDIF} + write {$IFDEF USE_FLAGS} SetIgnoreDefault {$ELSE} fIgnoreDefault {$ENDIF}; {* Change this property to TRUE to ignore default button reaction on press ENTER key when a focus is grabbed of the control. Default value is different for different controls. By default, DefaultBtn @@ -6116,7 +6441,7 @@ type {* If not accessed, correspondent TGraphicTool object is not created and its methods are not referenced. See also note on Font property. } - property Ctl3D: Boolean read fCtl3D write SetCtl3D; + property Ctl3D: Boolean read Get_Ctl3D write SetCtl3D; {* Inheritable from parent controls to child ones. } procedure Show; @@ -6163,12 +6488,8 @@ type {* The same as ShowModal, but all the windows of current thread are disabled while showing form modal. This is useful if KOL form from a DLL is used modally in non-KOL application. } - property ModalResult: Integer read fModalResult write - {$IFDEF USE_SETMODALRESULT} - SetModalResult; - {$ELSE} - fModalResult; - {$ENDIF} + property ModalResult: Integer read DF.fModalResult + write {$IFDEF USE_SETMODALRESULT} SetModalResult {$ELSE} DF.fModalResult {$ENDIF}; {* |<#form> Modal result. Set it to value<>0 to stop modal dialog. By agreement, value 1 corresponds 'OK', 2 - 'Cancel'. But it is totally by decision @@ -6176,7 +6497,7 @@ type property Modal: Boolean read GetModal; {* |<#form> TRUE, if the form is shown modal. } - property ModalForm: PControl read fModalForm write fModalForm; + property ModalForm: PControl read DF.fModalForm write DF.fModalForm; {* |<#form> |<#appbutton> Form currently shown modal from this form or from Applet. } @@ -6185,12 +6506,16 @@ type {* |<#appbutton> |<#form> Makes control hidden. } - property OnShow: TOnEvent read FOnShow write SetOnShow; + property OnShow: TOnEvent + read {$IFDEF EVENTS_DYNAMIC} Get_OnShow {$ELSE} EV.FOnShow {$ENDIF} + write SetOnShow; {* Is called when a control or form is to be shown. This event is not fired for a form, if its WindowState initially is set to wsMaximized or wsMinimized. This behaviour is by design (the window does not receive WM_SHOW message in such case). } - property OnHide: TOnEvent read FOnHide write SetOnHide; + property OnHide: TOnEvent + read {$IFDEF EVENTS_DYNAMIC} Get_OnHide {$ELSE} EV.FOnHide {$ENDIF} + write SetOnHide; {* Is called when a control or form becomes hidden. } property WindowState: TWindowState read GetWindowState write SetWindowState; {* |<#form> @@ -6229,7 +6554,9 @@ type in such case it is no more necessary to call also this method, but calling it therefore is not an error. } - property OnMessage: TOnMessage read fOnMessage write fOnMessage; + property OnMessage: TOnMessage + read {$IFDEF EVENTS_DYNAMIC} Get_OnMessage {$ELSE} EV.fOnMessage {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnMessage {$ELSE} EV.fOnMessage {$ENDIF}; {* |<#appbutton> |<#form> Is called for every message processed by TControl object. And for @@ -6242,17 +6569,17 @@ type |<#form> Returns True, if a window is the main in application (created first after the Applet, or matches the Applet). } - property IsApplet: Boolean read FIsApplet; + property IsApplet: Boolean read {$IFDEF USE_FLAGS} GetIsApplet {$ELSE} FIsApplet {$ENDIF}; {* Returns true, if the control is created using NewApplet (or CreateApplet). } - property IsForm: Boolean read fIsForm; + property IsForm: Boolean read {$IFDEF USE_FLAGS} GetIsForm {$ELSE} fIsForm {$ENDIF}; {* Returns True, if the object is form window. } - property IsMDIChild: Boolean read fIsMDIChild; + property IsMDIChild: Boolean read {$IFDEF USE_FLAGS} GetIsMDIChild {$ELSE} fIsMDIChild {$ENDIF}; {* Returns TRUE, if the object is MDI child form. In such case, IsForm also returns TRUE. } - property IsControl: Boolean read fIsControl; + property IsControl: Boolean read {$IFDEF USE_FLAGS} GetIsControl {$ELSE} fIsControl {$ENDIF}; {* Returns True, is the control is control (not form or applet). } - property IsButton: Boolean read fIsButton; + property IsButton: Boolean read {$IFDEF USE_FLAGS} GetIsButton {$ELSE} fIsButton {$ENDIF}; {* Returns True, if the control is button-like or containing buttons (button, bitbtn, checkbox, radiobox, toolbar). } @@ -6302,7 +6629,7 @@ type property StayOnTop: Boolean read GetStayOnTop write SetStayOnTop; {* |<#form> Obvious. Form-aware, but can be applied to controls. } - property Border: Integer read fMargin write fMargin; + property Border: ShortInt read fMargin write fMargin; {* |<#form> Distance between edges and child controls and between child controls by default (if methods PlaceRight, PlaceDown, PlaceUnder, @@ -6321,11 +6648,11 @@ type function SetBorder( Value: Integer ): PControl; {* Assigns new Border value, and returns @ Self. } - property Margin: Integer read fMargin write fMargin; + property Margin: ShortInt read fMargin write fMargin; {* |<#form> Old name for property Border. } - property MarginTop: Integer index 1 + property MarginTop: ShortInt index 1 {$IFDEF F_P} read GetClientMargin {$ELSE DELPHI} read fClientTop {$ENDIF F_P/DELPHI} write SetClientMargin; @@ -6340,7 +6667,7 @@ type ClientRect property, calculated for some types of controls. |
See also properties Border, MarginBottom, MarginLeft, MarginRight. } - property MarginBottom: Integer index 2 + property MarginBottom: ShortInt index 2 {$IFDEF F_P} read GetClientMargin {$ELSE DELPHI} read fClientBottom {$ENDIF F_P/DELPHI} write SetClientMargin; @@ -6349,7 +6676,7 @@ type should be POSITIVE to make logical bottom edge located above true edge. |
See also properties Border, MarginTop, MarginLeft, MarginRight. } - property MarginLeft: Integer index 3 + property MarginLeft: ShortInt index 3 {$IFDEF F_P} read GetClientMargin {$ELSE DELPHI} read fClientLeft {$ENDIF F_P/DELPHI} write SetClientMargin; @@ -6357,7 +6684,7 @@ type client rectangle and logical left edge. |
See also properties Border, MarginTop, MarginRight, MarginBottom. } - property MarginRight: Integer index 4 + property MarginRight: ShortInt index 4 {$IFDEF F_P} read GetClientMargin {$ELSE DELPHI} read fClientRight {$ENDIF F_P/DELPHI} write SetClientMargin; @@ -6367,12 +6694,18 @@ type |
See also properties Border, MarginTop, MarginLeft, MarginBottom. } - property Tabstop: Boolean read fTabstop write fTabstop; + property Tabstop: Boolean + {$IFDEF USE_FLAGS} + read GetTabStop write SetTabStop + {$ELSE} + read fTabstop write fTabstop + {$ENDIF} + ; {* True, if control can be focused using tabulating between controls. Set it to False to make control unavailable for keyboard, but only for mouse. } - property TabOrder: Integer read fTabOrder write SetTabOrder; + property TabOrder: SmallInt read fTabOrder write SetTabOrder; {* Order of tabulating of controls. Initially, TabOrder is equal to creation order of controls. If TabOrder changed, TabOrder of all controls with not less value of one is shifted up. To place @@ -6409,15 +6742,28 @@ type |<#panel> Text vertical alignment. Applicable to buttons, labels and panels. } {$IFDEF GDI} - property WordWrap: Boolean read fWordWrap write fWordWrap; + property WordWrap: Boolean + {$IFDEF USE_FLAGS} + read GetWordWrap write SetWordWrap + {$ELSE} + read fWordWrap write fWordWrap + {$ENDIF USE_FLAGS}; {* TRUE, if this is a label, created using NewWordWrapLabel. } - property ShadowDeep: Integer read FShadowDeep write SetShadowDeep; + property ShadowDeep: Integer read DF.FShadowDeep write SetShadowDeep; {* |<#3dlabel> Deep of a shadow (for label effect only, created calling NewLabelEffect). } - property CannotDoubleBuf: Boolean read fCannotDoubleBuf write fCannotDoubleBuf; + property CannotDoubleBuf: Boolean + {$IFDEF USE_FLAGS} + read GetCannotDoubleBuf write SetCannotDoubleBuf + {$ELSE} + read fCannotDoubleBuf write fCannotDoubleBuf + {$ENDIF}; {* } - property DoubleBuffered: Boolean read fDoubleBuffered write SetDoubleBuffered; + property DoubleBuffered: Boolean + read {$IFDEF USE_FLAGS} GetDoubleBuffered + {$ELSE} fDoubleBuffered {$ENDIF} + write SetDoubleBuffered; {* Set it to true for some controls, which are flickering in repainting (like label effect). Slow, and requires additional code. This property is inherited by all child controls. @@ -6425,7 +6771,9 @@ type Note: RichEdit control can not become DoubleBuffered. } function DblBufTopParent: PControl; {* Returns the topmost DoubleBuffered Parent control. } - property Transparent: Boolean read fTransparent write SetTransparent; + property Transparent: Boolean + read {$IFDEF USE_FLAGS} GetTransparent {$ELSE} fTransparent {$ENDIF} + write SetTransparent; {* Set it to true to get special effects. Transparency also uses DoubleBuffered and inherited by child controls. |
    @@ -6440,7 +6788,9 @@ type of a control). Another note is about Edit control. To allow editing of transparent edit box, it is necessary to invalidate it for every pressed character. Or, use Ed_Transparent property instead. } - property Ed_Transparent: Boolean read fTransparent write EdSetTransparent; + property Ed_Transparent: Boolean + read {$IFDEF USE_FLAGS} GetTransparent {$ELSE} fTransparent {$ENDIF} + write EdSetTransparent; {* |<#edit> |<#memo> Use this property for editbox to make it really Transparent. Remember, @@ -6453,7 +6803,8 @@ type (Win2K only). |
Depending on value assigned, it is possible to adjust transparency - level ( 0 - totally transparent, 255 - totally opaque). } + level ( 0 - totally transparent, 255 - totally opaque). + |
Note: from XP, any control can be alpha blended! } function MouseTransparent: PControl; {* Call this method to set up mouse transparent control (which always returns HTTRANSPARENT in responce to WM_NCHITTEST). This function @@ -6475,7 +6826,9 @@ type procedure SetOnClose( const AOnClose: TOnEventAccept ); procedure SetFormOnClick( const AOnClick: TOnEvent ); public - property OnClose: TOnEventAccept read fOnClose write SetOnClose; + property OnClose: TOnEventAccept + read {$IFDEF EVENTS_DYNAMIC} Get_OnClose {$ELSE} EV.fOnClose {$ENDIF} + write SetOnClose; {* |<#form> |<#applet> Called before closing the window. It is possible to set Accept @@ -6484,7 +6837,9 @@ type event, handle WM_QUERYENDSESSION message, or assign OnQueryEndSession event to another or the same event handler). } - property OnQueryEndSession: TOnEventAccept read fOnQueryEndSession write SetOnQueryEndSession; + property OnQueryEndSession: TOnEventAccept + read {$IFDEF EVENTS_DYNAMIC} Get_OnQueryEndSession {$ELSE} EV.fOnQueryEndSession {$ENDIF} + write SetOnQueryEndSession; {* |<#form> |<#applet> Called when WM_QUERYENDSESSION message come in. It is possible to set Accept @@ -6495,23 +6850,26 @@ type To provide normal application close while handling OnQueryEndSession, call in your code PostQuitMessage( 0 ) or call method Close for the main form, this is enough to provide all OnClose and OnDestroy handlers to be called. } - property CloseQueryReason: TCloseQueryReason read fCloseQueryReason; + property CloseQueryReason: TCloseQueryReason read DF.fCloseQueryReason; {* Reason why OnClose or OnQueryEndSession called. } - property OnMinimize: TOnEvent index 0 - {$IFDEF F_P} read GetOnMinMaxRestore - {$ELSE DELPHI} read fOnMinimize + property OnMinimize: TOnEvent index 0 read + {$IFDEF F_P} GetOnMinMaxRestore {$ELSE DELPHI} + {$IFDEF EVENTS_DYNAMIC} GetOnMinMaxRestore + {$ELSE} EV.fOnMinimize {$ENDIF} {$ENDIF F_P/DELPHI} write SetOnMinMaxRestore; {* |<#form> Called when window is minimized. } - property OnMaximize: TOnEvent index 8 - {$IFDEF F_P} read GetOnMinMaxRestore - {$ELSE DELPHI} read fOnMaximize + property OnMaximize: TOnEvent index 8 read + {$IFDEF F_P} GetOnMinMaxRestore {$ELSE DELPHI} + {$IFDEF EVENTS_DYNAMIC} GetOnMinMaxRestore + {$ELSE} EV.fOnMaximize {$ENDIF} {$ENDIF F_P/DELPHI} write SetOnMinMaxRestore; {* |<#form> Called when window is maximized. } - property OnRestore: TOnEvent index 16 - {$IFDEF F_P} read GetOnMinMaxRestore - {$ELSE DELPHI} read fOnRestore + property OnRestore: TOnEvent index 16 read + {$IFDEF F_P} GetOnMinMaxRestore {$ELSE DELPHI} + {$IFDEF EVENTS_DYNAMIC} GetOnMinMaxRestore + {$ELSE} EV.fOnMaximize {$ENDIF} {$ENDIF F_P/DELPHI} write SetOnMinMaxRestore; {* |<#form> Called when window is restored from minimized or maximized state. } @@ -6526,7 +6884,9 @@ type if the rectangle is in clipping region using API function RectInRegion. } - property EraseBackground: Boolean read fEraseUpdRgn write fEraseUpdRgn; + property EraseBackground: Boolean + read {$IFDEF USE_FLAGS} GetEraseBackground {$ELSE} fEraseUpdRgn {$ENDIF} + write {$IFDEF USE_FLAGS} SetEraseBackground {$ELSE} fEraseUpdRgn {$ENDIF}; {* This value is used to pass it to the API function GetUpdateRgn, when UpadateRgn property is obtained first in responce to WM_PAINT message. If EraseBackground is set to True, system is responsible @@ -6534,19 +6894,27 @@ type (default), the entire region invalidated should be painted by your event handler. } {$ENDIF GDI} - property OnPaint: TOnPaint read fOnPaint write SetOnPaint; + property OnPaint: TOnPaint + read {$IFDEF EVENTS_DYNAMIC} Get_OnPaint {$ELSE} EV.fOnPaint {$ENDIF} + write SetOnPaint; {* Event to set to override standard control painting. Can be applied to any control (though originally was designed only for paintbox control). When an event handler is called, it is possible to use UpdateRgn to examine what parts of window require painting to improve performance of the painting operation. } {$IFDEF GDI} - property OnPrePaint: TOnPaint read fOnPrePaint write fOnPrePaint; + property OnPrePaint: TOnPaint + read {$IFDEF EVENTS_DYNAMIC} Get_OnPrePaint {$ELSE} EV.fOnPrePaint {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnPrePaint {$ELSE} EV.fOnPrePaint {$ENDIF}; {* Only for graphic controls. If you assign it, call Invalidate also. } - property OnPostPaint: TOnPaint read fOnPostPaint write fOnPostPaint; + property OnPostPaint: TOnPaint + read {$IFDEF EVENTS_DYNAMIC} Get_OnPostPaint {$ELSE} EV.fOnPostPaint {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnPostPaint {$ELSE} EV.fOnPostPaint {$ENDIF}; {* Only for graphic controls. If you assign it, call Invalidate also. } - property OnEraseBkgnd: TOnPaint read fOnEraseBkgnd write SetOnEraseBkgnd; + property OnEraseBkgnd: TOnPaint + read {$IFDEF EVENTS_DYNAMIC} Get_OnEraseBkgnd {$ELSE} EV.fOnEraseBkgnd {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnEraseBkgnd {$ELSE} SetOnEraseBkgnd {$ENDIF}; {* This event allows to override erasing window background in response to WM_ERASEBKGND message. This allows to add some decorations to standard controls without overriding its painting in total. @@ -6573,9 +6941,11 @@ type } {$ENDIF GDI} - property OnClick: TOnEvent read fOnClick write - {$IFDEF GDI} fOnClick - {$ELSE _X_} SetOnClick {$ENDIF _X_}; + property OnClick: TOnEvent + read {$IFDEF EVENTS_DYNAMIC} Get_OnClick {$ELSE} EV.fOnClick {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} SetOnClick {$ELSE} + {$IFDEF GDI} EV.fOnClick + {$ELSE _X_} SetOnClick {$ENDIF _X_}{$ENDIF}; {* |<#button> |<#checkbox> |<#radiobox> @@ -6594,7 +6964,9 @@ type you want to have OnClick event to be fired on a Form, use (following) property OnFormClick to assign it. } {$IFDEF GDI} - property OnFormClick: TOnEvent read fOnClick write SetFormOnClick; + property OnFormClick: TOnEvent + read {$IFDEF EVENTS_DYNAMIC} Get_OnClick {$ELSE} EV.fOnClick {$ENDIF} + write SetFormOnClick; {* |<#form> Assign you OnClick event handler using this property, if you want it to be fired in result of mouse click on a form surface. Use to assign the @@ -6604,16 +6976,22 @@ type for both clicks. So if you install both OnFormClick and OnMouseDblClk, handlers will be called in the following sequence for each double click: OnFormClick; OnMouseDblClk; OnFormClick. } - property RightClick: Boolean read fRightClick; + property RightClick: Boolean read {$IFDEF USE_FLAGS} Get_RightClick {$ELSE} fRightClick {$ENDIF}; {* |<#toolbar> |<#listview> Use this property to determine which mouse button was clicked (applicable to toolbar in the OnClick event handler). } - property OnEnter: TOnEvent read fOnEnter write fOnEnter; + property OnEnter: TOnEvent index idx_fOnEnter + read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnEnter {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnEnter {$ENDIF}; {* Called when control receives focus. } - property OnLeave: TOnEvent read fOnLeave write fOnLeave; + property OnLeave: TOnEvent index idx_fOnLeave + read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnLeave {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnLeave{$ENDIF}; {* Called when control looses focus. } - property OnChange: TOnEvent read fOnChange write fOnChange; + property OnChange: TOnEvent index idx_fOnChange + read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnChange {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnChange {$ENDIF}; {* |<#edit> |<#memo> |<#listbox> @@ -6623,7 +7001,9 @@ type current index in combobox is changed (but if OnSelChanged assigned, the last is called for change selection). To respond to check/uncheck checkbox or radiobox events, use OnClick instead. } - property OnSelChange: TOnEvent read fOnSelChange write fOnSelChange; + property OnSelChange: TOnEvent index idx_fOnSelChange + read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnSelChange {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnSelChange{$ENDIF}; {* |<#richedit> |<#listbox> |<#combo> @@ -6631,40 +7011,48 @@ type Called for rich edit control, listbox, combobox or treeview when current selection (range, or current item) is changed. If not assigned, but OnChange is assigned, OnChange is called instead. } - property OnResize: TOnEvent read FOnResize write SetOnResize; + property OnResize: TOnEvent + read {$IFDEF EVENTS_DYNAMIC} Get_OnResize {$ELSE} EV.FOnResize {$ENDIF} + write SetOnResize; {* Called whenever control receives message WM_SIZE (thus is, if control is resized. } - property OnMove: TOnEvent read FOnMove write SetOnMove; + property OnMove: TOnEvent + read {$IFDEF EVENTS_DYNAMIC} Get_OnMove {$ELSE} EV.FOnMove {$ENDIF} + write SetOnMove; {* Called whenever control receives message WM_MOVE (i.e. when control is moved over its parent). } - property OnMoving: TOnEventMoving read FOnMoving write SetOnMoving; + property OnMoving: TOnEventMoving + read {$IFDEF EVENTS_DYNAMIC} Get_OnMoving {$ELSE} EV.FOnMoving {$ENDIF} + write SetOnMoving; {* Called whenever control receives message WM_MOVE (i.e. when control is moved over its parent). } - property MinSizePrev: Integer read fSplitMinSize1 write fSplitMinSize1; + property MinSizePrev: Integer read DF.fSplitMinSize1 write DF.fSplitMinSize1; {* |<#splitter> Minimal allowed (while dragging splitter) size of previous control for splitter (see NewSplitter). } - property SplitMinSize1: Integer read fSplitMinSize1 write fSplitMinSize1; - {* The same as MinSizePrev. } - property MinSizeNext: Integer read fSplitMinSize2 write fSplitMinSize2; + property SplitMinSize1: Integer read DF.fSplitMinSize1 write DF.fSplitMinSize1; + {* The same as MinSizePrev } + property MinSizeNext: Integer read DF.fSplitMinSize2 write DF.fSplitMinSize2; {* |<#splitter> Minimal allowed (while dragging splitter) size of the rest of parent of splitter or of SecondControl (see NewSplitter). } - property SplitMinSize2: Integer read fSplitMinSize2 write fSplitMinSize2; + property SplitMinSize2: Integer read DF.fSplitMinSize2 write DF.fSplitMinSize2; {* The same as MinSizeNext. } - property SecondControl: PControl read fSecondControl write fSecondControl; + property SecondControl: PControl read DF.fSecondControl write DF.fSecondControl; {* |<#splitter> Second control to check (while dragging splitter) if its size not less than SplitMinSize2 (see NewSplitter). By default, second control is not necessary, and needed only in rare case when SecondControl can not be determined automatically to restrict splitter right (bottom) position. } - property OnSplit: TOnSplit read fOnSplit write fOnSplit; + property OnSplit: TOnSplit + read {$IFDEF EVENTS_DYNAMIC} Get_OnSplit {$ELSE} EV.fOnSplit {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnSplit {$ELSE} EV.fOnSplit{$ENDIF}; {* |<#splitter> Called when splitter control is dragging - to allow for your event handler to decide if to accept new size of left (top) control, and new size of the rest area of parent. } - property Dragging: Boolean read FDragging; + property Dragging: Boolean read {$IFDEF USE_FLAGS} Get_Dragging {$ELSE} FDragging{$ENDIF}; {* |<#splitter> True, if splitter control is dragging now by user with left mouse button. Also, this property can be used to detect if the control @@ -6687,34 +7075,56 @@ type callback function OnDrag is called, which allows to control drop target, change cursor shape, etc. } - property OnKeyDown: TOnKey read fOnKeyDown write SetOnKeyDown; + property OnKeyDown: TOnKey + read {$IFDEF EVENTS_DYNAMIC} Get_OnKeyDown {$ELSE} EV.fOnKeyDown {$ENDIF} + write SetOnKeyDown; {* Obvious. } - property OnKeyUp: TOnKey read fOnKeyUp write SetOnKeyUp; + property OnKeyUp: TOnKey + read {$IFDEF EVENTS_DYNAMIC} Get_OnKeyUp {$ELSE} EV.fOnKeyUp {$ENDIF} + write SetOnKeyUp; {* Obvious. } - property OnChar: TOnChar read fOnChar write SetOnChar; + property OnChar: TOnChar + read {$IFDEF EVENTS_DYNAMIC} Get_OnChar {$ELSE} EV.fOnChar {$ENDIF} + write SetOnChar; {* Deprecated event, use OnKeyChar. } - property OnKeyChar: TOnChar read fOnChar write SetOnChar; + property OnKeyChar: TOnChar + read {$IFDEF EVENTS_DYNAMIC} Get_OnChar {$ELSE} EV.fOnChar {$ENDIF} + write SetOnChar; {* Obviuos. } {$IFDEF SUPPORT_ONDEADCHAR} - property OnKeyDeadChar: TOnChar read fOnDeadChar write SetOnDeadChar; + property OnKeyDeadChar: TOnChar + read {$IFDEF EVENTS_DYNAMIC} Get_OnDeadChar {$ELSE} EV.fOnDeadChar {$ENDIF} + write SetOnDeadChar; {* Obviuos. } {$ENDIF SUPPORT_ONDEADCHAR} {$ENDIF GDI} - property OnMouseUp: TOnMouse read fOnMouseUp write SetOnMouseUp; + property OnMouseUp: TOnMouse index idx_fOnMouseUp + read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseUp {$ENDIF} + write SetOnMouseEvent; {* Obvious. } - property OnMouseDown: TOnMouse read fOnMouseDown write SetOnMouseDown; + property OnMouseDown: TOnMouse index idx_fOnMouseDown + read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseDown {$ENDIF} + write SetOnMouseEvent; {* Obvious. } - property OnMouseMove: TOnMouse read fOnMouseMove write SetOnMouseMove; + property OnMouseMove: TOnMouse index idx_fOnMouseMove + read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseMove {$ENDIF} + write SetOnMouseEvent; {* Obvious. } - property OnMouseDblClk: TOnMouse read fOnMouseDblClk write SetOnMouseDblClk; + property OnMouseDblClk: TOnMouse index idx_fOnMouseDblClk + read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseDblClk {$ENDIF} + write SetOnMouseEvent; {* Obvious. } - property ThreeButtonPress: Boolean read f3ButtonPress; - {* TRUE, if 3 button press detected. Check this flag in OnMouseDblClk event - handler. If 3rd button click is done for a short period of time after the - double click, the control receives OnMouseDblClk the second time and this - flag is set. (Applicable to the GDK and other Linux systems). } - property OnMouseWheel: TOnMouse read fOnMouseWheel write SetOnMouseWheel; + property ThreeButtonPress: Boolean + read {$IFDEF USE_FLAGS} Get3ButtonPress {$ELSE} f3ButtonPress {$ENDIF}; + {* GDK (*nix) only. TRUE, if 3 button press detected. Check this flag in + OnMouseDblClk event handler. If 3rd button click is done for a short + period of time after the double click, the control receives OnMouseDblClk + the second time and this flag is set. (Applicable to the GDK and other + Linux systems). } + property OnMouseWheel: TOnMouse index idx_fOnMouseWheel + read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEvent {$ELSE} EV.fOnMouseWheel {$ENDIF} + write SetOnMouseEvent; {* Mouse wheel (up or down) event. In Windows, only focused controls and controls having scrollbars (or a scrollbar iteself) receive such message. To get direction and amount of wheel, use typecast: @@ -6722,13 +7132,19 @@ type step (-120 - for step back). } {$IFDEF GDI} - property OnMouseEnter: TOnEvent read fOnMouseEnter write SetOnMouseEnter; + property OnMouseEnter: TOnEvent + read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseEnter {$ELSE} EV.fOnMouseEnter {$ENDIF} + write SetOnMouseEnter; {* Is called when mouse is entered into control. See also OnMouseLeave. } - property OnMouseLeave: TOnEvent read fOnMouseLeave write SetOnMouseLeave; + property OnMouseLeave: TOnEvent + read {$IFDEF EVENTS_DYNAMIC} Get_OnMouseLeave {$ELSE} EV.fOnMouseLeave {$ENDIF} + write SetOnMouseLeave; {* Is called when mouse is leaved control. If this event is assigned, then mouse is captured on mouse enter event to handle all other mouse events until mouse cursor leaves the control. } - property OnTestMouseOver: TOnTestMouseOver read fOnTestMouseOver write SetOnTestMouseOver; + property OnTestMouseOver: TOnTestMouseOver + read {$IFDEF EVENTS_DYNAMIC} Get_OnTestMouseOver {$ELSE} EV.fOnTestMouseOver {$ENDIF} + write SetOnTestMouseOver; {* |<#bitbtn> Special event, which allows to extend OnMouseEnter / OnMouseLeave (and also Flat property for BitBtn control). If a handler is assigned @@ -6737,13 +7153,15 @@ type careful hot tracking for controls with non-rectangular shape (such as glyphed BitBtn control). } - property MouseInControl: Boolean read fMouseInControl; + property MouseInControl: Boolean + read {$IFDEF USE_FLAGS} GetMouseInCtl {$ELSE} fMouseInControl {$ENDIF}; {* |<#bitbtn> This property can return True only if OnMouseEnter / OnMouseLeave event handlers are set for a control (or, for BitBtn, property Flat is set to True. Otherwise, False is returned always. } - property Flat: Boolean read fFlat write SetFlat; + property Flat: Boolean read {$IFDEF USE_FLAGS} GetFlat {$ELSE} fFlat {$ENDIF} + write SetFlat; {* |<#bitbtn> Set it to True for BitBtn, to provide either flat border for a button or availability of "highlighting" (correspondent to glyph index 4). @@ -6765,7 +7183,7 @@ type ! end; ! end; } - property RepeatInterval: Integer read fRepeatInterval write fRepeatInterval; + property RepeatInterval: Integer read DF.fRepeatInterval write DF.fRepeatInterval; {* |<#bitbtn> If this property is set to non-zero, it is interpreted (for BitBtn only) as an interval in milliseconds between repeat button down events, @@ -6813,7 +7231,7 @@ type {* |<#progressbar> Obsolete. Now the same as Color. } - property StatusText[ Idx: Integer ]: PKOLChar read GetStatusText write SetStatusText; + property StatusText[ Idx: Integer ]: KOLString read GetStatusText write SetStatusText; {* |<#form> Only for forms to set/retrieve status text to/from given status panel. Panels are enumerated from 0 to 254, 255 is to indicate simple @@ -6835,7 +7253,7 @@ type align its widths to the same value (width divided to number of panels). To adjust status panel widths for every panel, use property StatusPanelRightX. } - property SimpleStatusText: PKOLChar index 255 read GetStatusText write SetStatusText; + property SimpleStatusText: KOLString index 255 read GetStatusText write SetStatusText; {* |<#form> Only for forms to set/retrive status text to/from simple status bar. Size grip in right bottom corner of status window is displayed only @@ -6869,8 +7287,13 @@ type Do not forget to provide StatusCtl to be existing first (e.g. assign one-space string to SimpleStatusText property of the form, for MCK do so using Object Inspector). + + Please note that not only a form can have status bar + but any other control too! } - property SizeGrip: Boolean read fSizeGrip write fSizeGrip; + property SizeGrip: Boolean + read {$IFDEF USE_FLAGS} GetSizeGrip {$ELSE} fSizeGrip {$ENDIF} + write {$IFDEF USE_FLAGS} SetSizeGrip {$ELSE} fSizeGrip {$ENDIF}; {* Size grip for status bar. Has effect only before creating window. } procedure RemoveStatus; @@ -6887,25 +7310,25 @@ type divided onto several subpanels). If the right edge for the last panel is set to -1 (by default) it is expanded to the right edge of a form window. Otherwise, status bar can be shorter then form width. } - property StatusWindow: HWND read fStatusWnd; + property StatusWindow: HWND read Get_StatusWnd; {* |<#form> Provided for case if You want to use API direct message sending to status bar. } - property Color1: TColor read fColor1 write SetColor1; + property Color1: TColor read DF.fColor1 write SetColor1; {* |<#gradient> Top line color for GradientPanel. } - property Color2: TColor read fColor2 write SetColor2; + property Color2: TColor read DF.fColor2 write SetColor2; {* |<#gradient> |<#3Dlabel> Bottom line color for GradientPanel, or shadow color for LabelEffect. (If clNone, shadow color for LabelEffect is calculated as a mix bitween TextColor and clBlack). } - property GradientStyle: TGradientStyle read FGradientStyle write SetGradientStyle; + property GradientStyle: TGradientStyle read DF.fGradientStyle write SetGradientStyle; {* |<#gradient> Styles other then gsVertical and gsHorizontal has effect only for gradient panel, created by NewGradientPanelEx. } - property GradientLayout: TGradientLayout read FGradientLayout write SetGradientLayout; + property GradientLayout: TGradientLayout read DF.fGradientLayout write SetGradientLayout; {* |<#gradient> Has only effect for gradient panel, created by NewGradientPanelEx. Ignored for styles gsVertical and gsHorizontal. } @@ -6994,11 +7417,11 @@ type By Mr Brdo. Index of page by its Caption. } //======== ListView style and options: - property LVStyle: TListViewStyle read fLVStyle write SetLVStyle; + property LVStyle: TListViewStyle read DF.fLVStyle write SetLVStyle; {* |<#listview> ListView style of view. Can be changed at run time. } - property LVOptions: TListViewOptions read fLVOptions write SetLVOptions; + property LVOptions: TListViewOptions read DF.fLVOptions write SetLVOptions; {* |<#listview> ListView options. Can be changed at run time. } @@ -7010,7 +7433,7 @@ type ListView text color. Use it instead of Font.Color. } property LVTextBkColor: TColor index LVM_GETTEXTBKCOLOR {$IFDEF F_P} read LVGetColorByIdx - {$ELSE DELPHI} read fLVTextBkColor + {$ELSE DELPHI} read DF.fLVTextBkColor {$ENDIF F_P/DELPHI} write LVSetColorByIdx; {* |<#listview> ListView background color for text. } @@ -7019,7 +7442,7 @@ type ListView background color. Use it instead of Color. } //======== List View columns handling: - property LVColCount: Integer read fLVColCount; + property LVColCount: Integer read DF.fLVColCount; {* |<#listview> ListView (additional) column count. Value 0 means that there are no columns (single item text / icon is used). If You want @@ -7266,27 +7689,35 @@ type of items in the list view control. } //======== List View specific events: - property OnEndEditLVItem: TOnEditLVItem read fOnEndEditLVITem write SetOnEndEditLVItem; + property OnEndEditLVItem: TOnEditLVItem + read {$IFDEF EVENTS_DYNAMIC} Get_OnEndEditLVItem {$ELSE} EV.fOnEndEditLVItem {$ENDIF} + write SetOnEndEditLVItem; {* |<#listview> Called when edit of an item label in ListView control finished. Return True to accept new label text, or false - to not accept it (item label will not be changed). If handler not set to an event, all changes are accepted. } - property OnLVDelete: TOnDeleteLVItem read fOnDeleteLVItem write SetOnDeleteLVItem; + property OnLVDelete: TOnDeleteLVItem + read {$IFDEF EVENTS_DYNAMIC} Get_OnDeleteLVItem {$ELSE} EV.fOnDeleteLVItem {$ENDIF} + write SetOnDeleteLVItem; {* |<#listview> This event is called when an item is deleted in the listview. Do not add, delete, or rearrange items in the list view while processing this notification. } - property OnDeleteLVItem: TOnDeleteLVItem read fOnDeleteLVItem write SetOnDeleteLVItem; + property OnDeleteLVItem: TOnDeleteLVItem + read {$IFDEF EVENTS_DYNAMIC} Get_OnDeleteLVItem {$ELSE} EV.fOnDeleteLVItem {$ENDIF} + write SetOnDeleteLVItem; {* |<#listview> Called for every deleted list view item. } - property OnDeleteAllLVItems: TOnEvent read fOnDeleteAllLVItems write SetOnDeleteAllLVItems; + property OnDeleteAllLVItems: TOnEvent read DF.fOnDeleteAllLVItems write SetOnDeleteAllLVItems; {* |<#listview> Called when all the items of the list view control are to be deleted. If after returning from this event handler event OnDeleteLVItem is yet assigned, an event OnDeleteLVItem will be called for every deleted item. } - property OnLVData: TOnLVData read fOnLVData write SetOnLVData; + property OnLVData: TOnLVData + read {$IFDEF EVENTS_DYNAMIC} Get_OnLVData {$ELSE} EV.fOnLVData {$ENDIF} + write SetOnLVData; {* |<#listview> Called to provide virtual list view with actual data. To use list view as virtaul list view, define also lvsOwnerData style and set Count property @@ -7294,20 +7725,28 @@ type control can greatly improve performance of an application when working with huge data sets represented in listview control. } - property OnCompareLVItems: TOnCompareLVItems read fOnCompareLVItems write fOnCompareLVItems; + property OnCompareLVItems: TOnCompareLVItems + read {$IFDEF EVENTS_DYNAMIC} Get_OnCompareLVItems {$ELSE} EV.fOnCompareLVItems {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnCompareLVItems {$ELSE} EV.fOnCompareLVItems {$ENDIF}; {* |<#listview> Event to compare two list view items during sort operation (initiated by LVSort method call). Do not send any messages to the list view control while it is sorting - results can be unpredictable! } - property OnColumnClick: TOnLVColumnClick read fOnColumnClick write SetOnColumnClick; + property OnColumnClick: TOnLVColumnClick + read {$IFDEF EVENTS_DYNAMIC} Get_OnColumnClick {$ELSE} EV.fOnColumnClick {$ENDIF} + write SetOnColumnClick; {* |<#listview> This event handler is called when column of the list view control is clicked. You can use this event to initiate sorting of list view items by this column. } - property OnLVStateChange: TOnLVStateChange read FOnLVStateChange write SetOnLVStateChange; + property OnLVStateChange: TOnLVStateChange + read {$IFDEF EVENTS_DYNAMIC} Get_OnLVStateChange {$ELSE} EV.FOnLVStateChange {$ENDIF} + write SetOnLVStateChange; {* |<#listview> This event occure when an item or items range in list view control are changing its state (e.g. selected or unselected). } - property OnDrawItem: TOnDrawItem read fOnDrawItem write SetOnDrawItem; + property OnDrawItem: TOnDrawItem + read {$IFDEF EVENTS_DYNAMIC} Get_OnDrawItem {$ELSE} EV.fOnDrawItem {$ENDIF} + write SetOnDrawItem; {* |<#listview> |<#listbox> |<#combo> @@ -7316,7 +7755,9 @@ type only in lvsDetail and lvsDetailNoHeader styles, and OnDrawItem is called to draw entire row at once only. See also OnLVCustomDraw event. } - property OnLVCustomDraw: TOnLVCustomDraw read FOnLVCustomDraw write SetOnLVCustomDraw; + property OnLVCustomDraw: TOnLVCustomDraw + read {$IFDEF EVENTS_DYNAMIC} Get_OnLVCustomDraw {$ELSE} EV.FOnLVCustomDraw {$ENDIF} + write SetOnLVCustomDraw; {* |<#listview> Custom draw event for listview. For every item to be drawn, this event can be called several times during a single drawing cycle - depending on @@ -7368,7 +7809,7 @@ type procedure Set_LVItemHeight(Value: Integer); function SetLVItemHeight(Value: Integer): PControl; - property LVItemHeight: Integer read fLVItemHeight write Set_LVItemHeight; + property LVItemHeight: Integer read DF.fLVItemHeight write Set_LVItemHeight; {* |<#listview> |<#listbox> |#combo> @@ -7494,13 +7935,12 @@ type TVHT_TORIGHT To the left of the client area | } - property TVRightClickSelect: Boolean read fTVRightClickSelect write SetTVRightClickSelect; + property TVRightClickSelect: Boolean read DF.fTVRightClickSelect write SetTVRightClickSelect; {* |<#treeview> Set this property to True to allow change selection to an item, clicked with right mouse button. } - property TVEditing: Boolean read fEditing; + property TVEditing: Boolean read GetTVEditing; {* |<#treeview> Returns True, if tree view control is editing its item label. } - property TVItemBold[ Item: THandle ]: Boolean index TVIS_BOLD read TVGetItemStateFlg write TVSetItemStateFlg; {* |<#treeview> True, if item is bold. } @@ -7573,29 +8013,44 @@ type {* |<#treeview> Ends editing item label, started by user or explicitly by TVEditItem method. } - property OnTVBeginDrag: TOnTVBeginDrag read fOnTVBeginDrag write fOnTVBeginDrag; + property OnTVBeginDrag: TOnTVBeginDrag + read {$IFDEF EVENTS_DYNAMIC} Get_OnTVBeginDrag {$ELSE} EV.fOnTVBeginDrag {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnTVBeginDrag {$ELSE} EV.fOnTVBeginDrag {$ENDIF}; {* |<#treeview> Is called for tree view, when its item is to be dragging. } - property OnTVBeginEdit: TOnTVBeginEdit read fOnTVBeginEdit write fOnTVBeginEdit; + property OnTVBeginEdit: TOnTVBeginEdit + read {$IFDEF EVENTS_DYNAMIC} Get_OnTVBeginEdit {$ELSE} EV.fOnTVBeginEdit {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnTVBeginEdit {$ELSE} EV.fOnTVBeginEdit {$ENDIF}; {* |<#treeview> - Is called for tree view, when its item label is to be editing. } - property OnTVEndEdit: TOnTVEndEdit read fOnTVEndEdit write fOnTVEndEdit; + Is called for tree view, when its item label is to be editing. + Return TRUE to allow editing of the item. } + property OnTVEndEdit: TOnTVEndEdit + read {$IFDEF EVENTS_DYNAMIC} Get_OnTVEndEdit {$ELSE} EV.fOnTVEndEdit {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnTVEndEdit {$ELSE} EV.fOnTVEndEdit {$ENDIF}; {* |<#treeview> Is called when item label is edited. It is possible to cancel edit, returning False as a result. } - property OnTVExpanding: TOnTVExpanding read fOnTVExpanding write fOnTVExpanding; + property OnTVExpanding: TOnTVExpanding + read {$IFDEF EVENTS_DYNAMIC} Get_OnTVExpanding {$ELSE} EV.fOnTVExpanding {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnTVExpanding {$ELSE} EV.fOnTVExpanding {$ENDIF}; {* |<#treeview> Is called just before expanding/collapsing item. It is possible to return TRUE to prevent expanding item, otherwise FALSE should be returned. } - property OnTVExpanded: TOnTVExpanded read fOnTVExpanded write fOnTVExpanded; + property OnTVExpanded: TOnTVExpanded + read {$IFDEF EVENTS_DYNAMIC} Get_OnTVExpanded {$ELSE} EV.fOnTVExpanded {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnTVExpanded {$ELSE} EV.fOnTVExpanded {$ENDIF}; {* |<#treeview> Is called after expanding/collapsing item children. } - property OnTVDelete: TOnTVDelete read fOnTVDelete write SetOnTVDelete; + property OnTVDelete: TOnTVDelete + read {$IFDEF EVENTS_DYNAMIC} Get_OnTVDelete {$ELSE} EV.fOnTVDelete {$ENDIF} + write SetOnTVDelete; {* |<#treeview> Is called just before deleting item. You may use this event to free resources, associated with an item (see TVItemData property). } //----------------- by Sergey Shisminzev: - property OnTVSelChanging: TOnTVSelChanging read fOnTVSelChanging write fOnTVSelChanging; + property OnTVSelChanging: TOnTVSelChanging + read {$IFDEF EVENTS_DYNAMIC} Get_OnTVSelChanging {$ELSE} EV.fOnTVSelChanging {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnTVSelChanging {$ELSE} EV.fOnTVSelChanging {$ENDIF}; {* |<#treeview> Is called before changing the selection. The handler can return FALSE to prevent changing the selection. } @@ -7637,8 +8092,8 @@ type create rc-file manually and compile using Borland Resource Compiler to figure it out. } - function TBAddButtons( const Buttons: array of PKOLChar; const BtnImgIdxArray: array - of Integer ): Integer; + function TBAddButtons( const Buttons: array of PKOLChar; + const BtnImgIdxArray: array of Integer ): Integer; {* |<#toolbar> Adds buttons to toolbar. Last string in Buttons array *must* be empty ('' or nil), so to add buttons without text, pass ' ' string (one space @@ -7671,7 +8126,7 @@ type once) ids are started from value 100. } function TBInsertButtons( BeforeIdx: Integer; Buttons: array of PKOLChar; - BtnImgIdxArray: array of Integer ): Integer; + const BtnImgIdxArray: array of Integer ): Integer; {* |<#toolbar> Inserts buttons before button with given index on toolbar. Returns command identifier for first button inserted (other can be calculated @@ -7707,7 +8162,7 @@ type {* |<#toolbar> Resets image index for BtnCount buttons starting from BtnID. } - property CurItem: Integer read fCurItem; + //property CurItem: Integer read DF.fTBCurItem; {* |<#toolbar> For toolbar, in OnClick event this property can be used to determine which button was clicked (100-based button id in toolbar). It is also @@ -7716,12 +8171,15 @@ type At least, it is possible to call TBItem2Index function to convert button ID to its index in toolbar. } + property TBCurItem: Integer read DF.fTBCurItem; + {* |<#toolbar> + Same as CurItem. } property TBButtonCount: Integer read GetItemsCount; //TBGetButtonCount; {* |<#toolbar> Returns count of buttons on toolbar. The same as Count. } - property TBBtnImgWidth: Integer read fTBBtnImgWidth write fTBBtnImgWidth; + property TBBtnImgWidth: Integer read DF.fTBBtnImgWidth write DF.fTBBtnImgWidth; {* |<#toolbar> Custom toolbar buttons width. Set it before assigning buttons bitmap. Changing this property after assigning the bitmap has no effect. } @@ -7803,13 +8261,13 @@ type property TBButtonsMinWidth: Integer index 0 {$IFDEF F_P} read TBGetBtMinMaxWidth - {$ELSE DELPHI} read FTBBtMinWidth + {$ELSE DELPHI} read DF.fTBBtMinWidth {$ENDIF F_P/DELPHI} write TBSetBtMinMaxWidth; {* |<#toolbar> Allows to set minimal width for all toolbar buttons. } property TBButtonsMaxWidth: Integer index 1 {$IFDEF F_P} read TBGetBtMinMaxWidth - {$ELSE DELPHI} read FTBBtMaxWidth + {$ELSE DELPHI} read DF.fTBBtMaxWidth {$ENDIF F_P/DELPHI} write TBSetBtMinMaxWidth; {* |<#toolbar> Allows to set maximal width for all toolbar buttons. } @@ -7845,21 +8303,402 @@ type is useful both for static and dynamic toolbars (meaning "dynamic" - toolbars with buttons, deleted and inserted at run-time). } - property OnTBDropDown: TOnEvent read fOnDropDown write fOnDropDown; + property TBAutoSizeButtons: Boolean read GetTBAutoSizeButtons write SetTBAutoSizeButtons; + + property OnTBDropDown: TOnEvent index idx_FOnDropDown + read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnDropDown {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnDropDown {$ENDIF}; {* |<#toolbar> This event is called for drop down buttons, when user click drop part of drop down button. To determine for which button event is called, look at CurItem or CurIndex property. It is also possible to use common (with combobox) property OnDropDown. } - property OnTBClick: TOnEvent read fOnClick write fOnClick; + property OnTBClick: TOnEvent + read {$IFDEF EVENTS_DYNAMIC} Get_OnClick {$ELSE} EV.fOnClick {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} SetOnClick {$ELSE} EV.fOnClick{$ENDIF}; {* |<#toolbar> The same as OnClick. } - property OnTBCustomDraw: TOnTBCustomDraw read fOnTBCustomDraw write SetOnTBCustomDraw; + property OnTBCustomDraw: TOnTBCustomDraw read DF.fOnTBCustomDraw write SetOnTBCustomDraw; {* |<#toolbar> An event (mainly) to customize toolbar background. } + //---------------------------------------------------------------------- + // DateTimePicker + property OnDTPUserString: TDTParseInputEvent + read {$IFDEF EVENTS_DYNAMIC} Get_OnDTPUserString {$ELSE} EV.FOnDTPUserString {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnDTPUserString {$ELSE} EV.FOnDTPUserString{$ENDIF}; + {* Special event to parse input from the application. Option dtpoParseInput + must be set when control is created. } + property DateTime: TDateTime read GetDateTime write SetDateTime; + {* DateTime for DateTimePicker control only. } + property Date: TDateTime read GetDate write SetDate; + {* Date only for DateTimePicker control only. } + property Time: TDateTime read GetTime write SetTime; + {* Time only for DateTimePicker control only. } + property SystemTime: TSystemTime read Get_SystemTime write Set_SystemTime; + {* Date and Time as TSystemTime. When assing, use year 0 to set "no value". } + property DateTimeRange: TDateTimeRange read GetDateTimeRange + write SetDateTimeRange; + {* DateTimePicker range. If first date in the agrument assigned is NAN, + minimum system allowed value is used as the left bound, and if the second is + NAN, maximum system allowed is used as the right one. } + property DateTimePickerColors[ Index: TDateTimePickerColor ]: TColor + read GetDateTimePickerColor write SetDateTimePickerColor; + property DateTimeFormat: KOLString write SetDateTimeFormat; + //---------------------------------------------------------------------- + + //---------------------------------------------------------------------- + // ScrollBar + property SBMin: Longint read DF.fSBMinMax.X write SetSBMin; + {* Minimum scrolling area position. } + property SBMax: Longint read DF.fSBMinMax.Y write SetSBMax; + {* Maximum scrolling area position (size of the text or image to be scrolling). + For case when SCROLL_OLD defined, this value should be set as scrolling + object size without SBPageSize. } + property SBMinMax: TPoint read DF.fSBMinMax write SetSBMinMax; + {* The property to adjust SBMin and SBMax for a single call (set X to a minimum + and Y to a maximum value). } + property SBPosition: Integer read DF.fSBPosition write SetSBPosition; + {* Current scroll position. When set, should be between SBMin and + SBMax - max(0, SBPageSize-1) } + property SBPageSize: Integer read DF.fSBPageSize write SetSBPageSize; + {* } + + property OnSBBeforeScroll: TOnSBBeforeScroll + read {$IFDEF EVENTS_DYNAMIC} Get_OnSBBeforeScroll {$ELSE} EV.FOnSBBeforeScroll {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnSBBeforeScroll {$ELSE} EV.FOnSBBeforeScroll {$ENDIF}; + {* } + property OnSBScroll: TOnSBScroll + read {$IFDEF EVENTS_DYNAMIC} Get_OnSBScroll {$ELSE} EV.FOnSBScroll {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_OnSBScroll {$ELSE} EV.FOnSBScroll {$ENDIF}; + {* } + + function SBSetScrollInfo(const SI: TScrollInfo): Integer; + function SBGetScrollInfo(var SI: TScrollInfo): Boolean; + function GetSBMinMax: TPoint; + function GetSBPageSize: Integer; + function GetSBPosition: Integer; + //---------------------------------------------------------------------- + + // "Through", or "transparent" methods to simplify initial + // adjustment of controls and make non-visual designing of + // forms more easy. All these functions return @Self as a + // result, so, it is possible to use such methods immediately + // in constructing statement, concatenating it with dots, e.g.: + // + // NewButton( MyForm, 'Click here' ).PlaceUnder.ResizeParentBottom; + // + {$ENDIF GDI} + function PlaceRight: PControl; + {* Places control right (to previously created on the same parent). } + function PlaceDown: PControl; + {* Places control below (to previously created on the same parent). + Left position is not changed (thus is, kept equal to Parent.Margin). } + function PlaceUnder: PControl; + {* Places control below (to previously created one, aligning its + Left position to Left position of previous control). } + function SetSize( W, H: Integer ): PControl; + {* Changes size of a control. If W or H less or equal to 0, + correspondent size is not changed. } + {$IFDEF GDI} + function Size( W, H: Integer ): PControl; + {* Like SetSize, but provides automatic resizing of parent control + (recursively). Especially useful for aligned controls. } + function SetClientSize( W, H: Integer ): PControl; + {* Like SetSize, but works setting W = ClientWidth, H = ClientHeight. + Use this method for forms, which can not be resized (dialogs). } + + {$ENDIF GDI} + function AutoSize( AutoSzOn: Boolean ): PControl; + {$IFDEF GDI} + function MakeWordWrap: PControl; + + {* Determines if to autosize control (like label, button, etc.) } + function IsAutoSize: Boolean; + {* TRUE, if a control is autosizing. } + function AlignLeft( P: PControl ): PControl; + {* assigns Left := P.Left } + function AlignTop( P: PControl ): PControl; + {* assigns Top := P.Top } + function ResizeParent: PControl; + {* Resizes parent, calling ResizeParentRight and ResizeParentBottom. } + function ResizeParentRight: PControl; + {* Resizes parent right edge (Margin of parent is added to right + coordinate of a control). If called second time (for the same + parent), resizes only for increasing of right edge of parent. } + + function ResizeParentBottom: PControl; + {* Resizes parent bottom edge (Margin of parent is added to + bottom coordinate of a control). } + function CenterOnParent: PControl; + {* Centers control on parent, or if applied to a form, centers + form on screen. } + + function Shift( dX, dY : Integer ): PControl; + {* Moves control respectively to current position (Left := Left + dX, + Top := Top + dY). } + {$ENDIF GDI} + function SetPosition( X, Y: Integer ): PControl; + {* Moves control directly to the specified position. } + {$IFDEF GDI} + + function Tabulate: PControl; + {* Call it once for form/applet to provide tabulation between controls on + form/on all forms using TAB / SHIFT+TAB and arrow keys. } + function TabulateEx: PControl; + {* Call it once for form/applet to provide tabulation between controls on + form/on all forms using TAB / SHIFT+TAB and arrow keys. Arrow keys are + used more smart, allowing go to nearest control in certain direction. } + + function SetAlign( AAlign: TControlAlign ): PControl; + {* Assigns passed value to property Align, aligning control on parent, + and returns @Self (so it is "transparent" function, which can be + used to adjust control at the creation, e.g.: + ! MyLabel := NewLabel( MyForm, 'Label1' ).SetAlign( caBottom ); + See also property Align. } + //{-2.95}//function PreventResizeFlicks: PControl; + { * + If called, prevents resizing flicks for child controls, aligned to + right and bottom (but with a lot of code added to executable - about 3,5K). + There is sensible to set DoubleBuffered to True also to eliminate the + most of flicks. + |
    + This method been applied to a form, prevents, resizing flicks for + form and all controls on the form. If it is called for applet window, + all forms are affected. And if You want, You can apply it for certain + control only - in such case only given control and its children will + be resizing without flicks (e.g., using splitter control). } //{-2.95} + + property Checked: Boolean read GetChecked write Set_Checked; + {* |<#checkbox> + |<#radiobox> + |<#bitbtn> + For checkbox and radiobox - if it is checked. Do not assign + value for radiobox - use SetRadioChecked instead. } + function SetChecked(const Value: Boolean): PControl; + {* |<#checkbox> + Use it to check/uncheck check box control or push button. + Do not apply it to check radio buttons - use SetRadioChecked + method below. } + function SetRadioChecked : PControl; + {* |<#radiobox> + Use it to check radio button item correctly (unchecking all + alternative ones). Actually, method Click is called, and control + itself is returned. } + property Check3: TTriStateCheck read GetCheck3 write SetCheck3; + {* |<#checkbox> + State of checkbox with BS_AUTO3STATE style. } + procedure Click; + {* |<#button> + |<#checkbox> + |<#radiobox> + Emulates click on control programmatically, sending WM_COMMAND + message with BN_CLICKED code. This method is sensible only for + buttons, checkboxes and radioboxes. } + + function Perform( msgcode: DWORD; wParam, lParam: Integer): Integer; stdcall; + {* Sends message to control's window (created if needed). } + function Postmsg( msgcode: DWORD; wParam, lParam: Integer): Boolean; stdcall; + {* Sends message to control's window (created if needed). } + procedure AttachProc( Proc: TWindowFunc ); + {* It is possible to attach dynamically any message handler to window + procedure using this method. Last attached procedure is called first. + If procedure returns True, further processing of a message is stopped. + Attached procedure can be detached using DetachProc (but do not + attach/detach procedures during handling of attached procedure - + this can hang application). } + procedure AttachProcEx( Proc: TWindowFunc; ExecuteAfterAppletTerminated: Boolean ); + {* The same as AttachProc, but a handler is executed even after terminating + the main message loop processing (i.e. after assigning true to + AppletTerminated global variable. } + function IsProcAttached( Proc: TWindowFunc ): Boolean; + {* Returns True, if given procedure is already in chain of attached + ones for given control window proc. } + procedure DetachProc( Proc: TWindowFunc ); + {* Detaches procedure attached earlier using AttachProc. } + + property OnDropFiles: TOnDropFiles + read {$IFDEF EVENTS_DYNAMIC} Get_OnDropFiles {$ELSE} EV.FOnDropFiles {$ENDIF} + write SetOnDropFiles; + {* Assign this event to your handler, if You want to accept drag and drop + files from other applications such as explorer onto your control. When + this event is assigned to a control or form, this has effect also for + all its child controls too. } + + property CustomData: Pointer read fCustomData write fCustomData; + {* Can be used to exend the object when new type of control added. Memory, + pointed by this pointer, released automatically in the destructor. } + property CustomObj: PObj read fCustomObj write fCustomObj; + {* Can be used to exend the object when new type of control added. Object, + pointed by this pointer, released automatically in the destructor. } + procedure SetAutoPopupMenu( PopupMenu: PObj ); + {* To assign a popup menu to the control, call SetAutoPopupMenu method of + the control with popup menu object as a parameter. } + + function SupportMnemonics: PControl; + {* This method provides supporting mnemonic keys in menus, buttons, checkboxes, + toolbar buttons. } + property OnScroll: TOnScroll + read {$IFDEF EVENTS_DYNAMIC} Get_OnScroll {$ELSE} EV.FOnScroll {$ENDIF} + write SetOnScroll; + {* } + public + {$IFDEF USE_DROPDOWNCOUNT} + property DropDownCount: Cardinal read DF.fDropDownCount write DF.fDropDownCount; + {$ENDIF} + protected + {$IFDEF USE_GRAPHCTLS} + {} fKeyboardProcess: TOnMessage; // for graphic controls ??? + {} fSetFocus: procedure(Ctl: PControl); + {} fPushedBtn: PControl; + {} fSaveCursor: HCursor; + function DoGraphCtlPrepaint: TRect; + procedure GraphicLabelPaint( DC: HDC ); + procedure GraphicCheckBoxPaint( DC: HDC ); + procedure GraphicCheckBoxMouse( var Msg: TMsg ); + procedure GraphicRadioBoxPaint( DC: HDC ); + procedure GraphicButtonPaint( DC: HDC ); + procedure GraphicButtonMouse( var Msg: TMsg ); + function GraphButtonKeyboardProcess( var Msg: TMsg; var Rslt: Integer ): Boolean; + procedure LeaveGraphButton( Sender: PObj ); + procedure GraphicEditPaint( DC: HDC ); + procedure GraphicEditMouse( var Msg: TMsg ); + procedure DestroyGraphEdit( Sender: PObj ); + procedure LeaveGraphEdit( Sender: PObj ); + procedure ChangeGraphEdit( Sender: PObj ); + procedure GraphCtlDrawFocusRect( DC: HDC; const R: TRect ); + {$IFDEF GRAPHCTL_HOTTRACK} + procedure MouseLeaveFromParentOfGraphCtl( Sender: PObj ); + {$ENDIF GRAPHCTL_HOTTRACK} + procedure GroupBoxPaint( DC: HDC ); + {$ENDIF USE_GRAPHCTLS} + {$IFDEF KEY_PREVIEW} + public + property KeyPreview: Boolean + read {$IFDEF USE_FLAGS} GetKeyPreview {$ELSE} fKeyPreview {$ENDIF} + write {$IFDEF USE_FLAGS} SetKeyPreview {$ELSE} fKeyPreview {$ENDIF}; + //property KeyPreviewing: Boolean read fKeyPreviewing write fKeyPreviewing; + {$ENDIF KEY_PREVIEW} + protected + fOldWidth: Word; + fOldHeight: Word; + fClickDisabled: Byte; + fAnchors: Byte; + fNestedMsgHandling: SmallInt; + {* level of nested message handling for a control. Only when it is 0 at + the end of message handling and fBeginDestroying set, the control is + destroyed. } + fUpdateCount: SmallInt; + public + property AnchorLeft: Boolean index ANCHOR_LEFT read GetAnchor write SetAnchor; //+Sormart + property AnchorTop: Boolean index ANCHOR_TOP read GetAnchor write SetAnchor; //+Sormart + property AnchorRight: Boolean index ANCHOR_RIGHT read GetAnchor write SetAnchor; + property AnchorBottom: Boolean index ANCHOR_BOTTOM read GetAnchor write SetAnchor; + 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} + // If an option USE_CUSTOMEXTENSIONS is enabled (at the beginning of this + // unit), You can freely extend TControl definition by your own fields, + // 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). + // 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 + // for TControl, CUSTOM_KOL_EXTENSION.inc, containing needed global + // declarations, and CUSTOM_CODE_EXTENSION.inc, the implementation of those + // two. + // Because KOL is always grow and constantly is extending by me, I also can + // add my own complements for TControl. To avoid naming conflicts, I suggest + // 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 // rare used fields are moved here from top to make code smaller a bit + //fFocusHandle: HWnd; // to store handle of focused control of form ? + FParentWnd: HWnd; // <<-- ++ for InitOrthaned !! + fParentCoordX: SmallInt; + fParentCoordY: SmallInt; + //fMDIClient: PControl; + //{* MDI client window control } + //fMDIChildren: PList; + //{* List of MDI children. It is filled for MDI client window. } + + {$IFDEF USE_fNCDestroyed} + {} fNCDestroyed: Boolean; + {$ENDIF USE_fNCDestroyed} + public + property MDIClient: PControl read Get_MDIClient write Set_MDIClient; + {* For MDI forms only: returns MDI client window control, containng all MDI + children. Use this window to send specific messages to rule MDI children. } + {$IFDEF OBSOLETE_FIELDS} + {} fPaintLater: Boolean; + {$ENDIF OBSOLETE_FIELDS} + // last changes (1-Jul-06) from ECM [Michalichenko Eugeny, rest in peace, friend]: + //======== ListBox + private + function GetLBTopIndex: Integer; + procedure SetLBTopIndex(const Value: Integer); + public + function LBItemAtPos(X,Y: Integer): Integer; + {* |<#listbox> + Return index of item at the given position. } + property LBTopIndex: Integer read GetLBTopIndex write SetLBTopIndex; + {* |<#listbox> + Index of the first visible item in a list box} + public //================== RichEdit specific: ================== {$IFNDEF NOT_USE_RICHEDIT} property MaxTextSize: DWORD read GetMaxTextSize write SetMaxTextSize; @@ -7887,7 +8726,7 @@ type {* |<#richedit> By Savva. Returns length of rich edit text. } - property RE_CharFmtArea: TRichFmtArea read fRECharArea write fRECharArea; + property RE_CharFmtArea: TRichFmtArea read DF.fRECharArea write DF.fRECharArea; {* |<#richedit> By default, this property is raSelection. Changing it, You determine in for which area characters format is applyed, when changing @@ -8280,11 +9119,13 @@ type this property (You also have to initialize monitoring procedure by either reading RE_OverwriteMode property or assigning handler to event OnRE_InsOvrMode_Change immediately following RichEdit control creation). } - property OnRE_InsOvrMode_Change: TOnEvent read fOnREInsModeChg write fOnREInsModeChg; + property OnRE_InsOvrMode_Change: TOnEvent index idx_FOnREInsModeChg + read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnREInsModeChg {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnREInsModeChg {$ENDIF}; {* |<#richedit> This event is called, whenever key INSERT is pressed in control (and for RichEdit, this means, that insert mode is changed). } - property RE_DisableOverwriteChange: Boolean read fReOvrDisable write RESetOvrDisable; + property RE_DisableOverwriteChange: Boolean read DF.fReOvrDisable write RESetOvrDisable; {* |<#richedit> It is possible to disable switching between "insert" and "overwrite" mode by user (therefore, event OnRE_InsOvrMode_Change continue works, but it @@ -8292,7 +9133,7 @@ type is not actually changed if switching is disabled). } function RE_LoadFromStream( Stream: PStream; Length: Integer; - Format: TRETextFormat; SelectionOnly: Boolean ): Boolean; + {} Format: TRETextFormat; SelectionOnly: Boolean ): Boolean; {* |<#richedit> Use this method rather then assignment to RE_Text property, if source is stored in file or stream (to minimize resources during @@ -8318,7 +9159,9 @@ type compare current stream position with RE_Size[ rsBytes ] property value). } - property OnProgress: TOnEvent read fOnProgress write fOnProgress; + property OnProgress: TOnEvent index idx_FOnProgress + read {$IFDEF EVENTS_DYNAMIC} Get_TOnEvent {$ELSE} EV.fOnProgress {$ENDIF} + write {$IFDEF EVENTS_DYNAMIC} Set_TOnEvent {$ELSE} EV.fOnProgress {$ENDIF}; {* |<#richedit> This event is called during RE_SaveToStream, RE_LoadFromStream (and also during RE_SaveToFile, RE_LoadFromFile and while accessing or changing @@ -8327,12 +9170,12 @@ type or with rich edit text size, while writing (property RE_TextSize[ rsBytes ]). } function RE_LoadFromFile( const Filename: KOLString; Format: TRETextFormat; - SelectionOnly: Boolean ): Boolean; + {} SelectionOnly: Boolean ): Boolean; {* |<#richedit> Use this method rather then other assignments to RE_Text property, if a source for RichEdit is the file. See also RE_LoadFromStream. } function RE_SaveToFile( const Filename: KOLString; Format: TRETextFormat; - SelectionOnly: Boolean ): Boolean; + {} SelectionOnly: Boolean ): Boolean; {* |<#richedit> Use this method rather then other similar, if You want to store entire content of RichEdit or selection only of RichEdit to a file. } @@ -8356,7 +9199,7 @@ type {* } procedure RE_InsertRTF( const S: KOLString ); {* } - property RE_Error: Integer read fREError; + property RE_Error: Integer read DF.fREError; {* |<#richedit> Contains error code, if access to RE_Text failed. } @@ -8395,21 +9238,21 @@ type or event OnRE_OverURL are set, property RE_AutoURLDetect is set to True automatically. } - property RE_URL: KOLString read fREUrl; + property RE_URL: PKOLChar read DF.fREUrl; {* |<#richedit> Detected URL (valid in OnRE_OverURL and OnRE_URLClick event handlers). } - property OnRE_OverURL: TOnEvent index 0 - {$IFDEF F_P} read REGetOnURL - {$ELSE DELPHI} read fOnREOverURL - {$ENDIF F_P/DELPHI} write RESetOnURL; + property OnRE_OverURL: TOnEvent index 0 read {$IFDEF EVENTS_DYNAMIC} REGetOnURL {$ELSE} + {$IFDEF F_P} REGetOnURL + {$ELSE DELPHI} EV.fOnREOverURL + {$ENDIF F_P/DELPHI} {$ENDIF} write RESetOnURL; {* |<#richedit> Is called when mouse is moving over URL. This can be used to set cursor, for example, depending on type of URL (to determine URL type read property RE_URL). } - property OnRE_URLClick: TOnEvent index 8 - {$IFDEF F_P} read REGetOnURL - {$ELSE DELPHI} read fOnREURLClick - {$ENDIF F_P/DELPHI} write RESetOnURL; + property OnRE_URLClick: TOnEvent index 8 read {$IFDEF EVENTS_DYNAMIC} REGetOnURL {$ELSE} + {$IFDEF F_P} REGetOnURL + {$ELSE DELPHI} EV.fOnREURLClick + {$ENDIF F_P/DELPHI} {$ENDIF} write RESetOnURL; {* |<#richedit> Is called when click on URL detected. } @@ -8460,400 +9303,250 @@ type multiline edit control and RichEdit control, the return value is TRUE if the undo operation is successful, or FALSE if the undo operation fails. } + public + property PropInt[ PropName: PKOLChar ]: Integer read Get_Prop_Int write Set_Prop_Int; + {* For any windowed control: use it to store desired property in window + properties. } {$IFNDEF NOT_USE_RICHEDIT} function RE_Redo: Boolean; + procedure FreeCharFormatRec; {* |<#richedit> Only for RichEdit control: Returns True if successful. } {$ENDIF NOT_USE_RICHEDIT} - - //---------------------------------------------------------------------- - // DateTimePicker - property OnDTPUserString: TDTParseInputEvent read FOnDTPUserString - write FOnDTPUserString; - {* Special event to parse input from the application. Option dtpoParseInput - must be set when control is created. } - property DateTime: TDateTime read GetDateTime write SetDateTime; - {* DateTime for DateTimePicker control only. } - property Date: TDateTime read GetDate write SetDate; - {* Date only for DateTimePicker control only. } - property Time: TDateTime read GetTime write SetTime; - {* Time only for DateTimePicker control only. } - property SystemTime: TSystemTime read Get_SystemTime write Set_SystemTime; - {* Date and Time as TSystemTime. When assing, use year 0 to set "no value". } - property DateTimeRange: TDateTimeRange read GetDateTimeRange - write SetDateTimeRange; - {* DateTimePicker range. If first date in the agrument assigned is NAN, - minimum system allowed value is used as the left bound, and if the second is - NAN, maximum system allowed is used as the right one. } - property DateTimePickerColors[ Index: TDateTimePickerColor ]: TColor - read GetDateTimePickerColor write SetDateTimePickerColor; - property DateTimeFormat: AnsiString write SetDateTimeFormat; - - //---------------------------------------------------------------------- - - //---------------------------------------------------------------------- - // ScrollBar - property SBMin: Longint read fSBMinMax.X write SetSBMin; - {* Minimum scrolling area position. } - property SBMax: Longint read fSBMinMax.Y write SetSBMax; - {* Maximum scrolling area position (size of the text or image to be scrolling). - For case when SCROLL_OLD defined, this value should be set as scrolling - object size without SBPageSize. } - property SBMinMax: TPoint read fSBMinMax write SetSBMinMax; - {* The property to adjust SBMin and SBMax for a single call (set X to a minimum - and Y to a maximum value). } - property SBPosition: Integer read fSBPosition write SetSBPosition; - {* Current scroll position. When set, should be between SBMin and - SBMax - max(0, SBPageSize-1) } - property SBPageSize: Integer read fSBPageSize write SetSBPageSize; - {* } - - property OnSBBeforeScroll: TOnSBBeforeScroll read FOnSBBeforeScroll write FOnSBBeforeScroll; - {* } - property OnSBScroll: TOnSBScroll read FOnSBScroll write FOnSBScroll; - {* } - - function SBSetScrollInfo(const SI: TScrollInfo): Integer; - function SBGetScrollInfo(var SI: TScrollInfo): Boolean; - function GetSBMinMax: TPoint; - function GetSBPageSize: Integer; - function GetSBPosition: Integer; - //---------------------------------------------------------------------- - - // "Through", or "transparent" methods to simplify initial - // adjustment of controls and make non-visual designing of - // forms more easy. All these functions return @Self as a - // result, so, it is possible to use such methods immediately - // in constructing statement, concatenating it with dots, e.g.: - // - // NewButton( MyForm, 'Click here' ).PlaceUnder.ResizeParentBottom; - // - {$ENDIF GDI} - function PlaceRight: PControl; - {* Places control right (to previously created on the same parent). } - function PlaceDown: PControl; - {* Places control below (to previously created on the same parent). - Left position is not changed (thus is, kept equal to Parent.Margin). } - function PlaceUnder: PControl; - {* Places control below (to previously created one, aligning its - Left position to Left position of previous control). } - function SetSize( W, H: Integer ): PControl; - {* Changes size of a control. If W or H less or equal to 0, - correspondent size is not changed. } - {$IFDEF GDI} - function Size( W, H: Integer ): PControl; - {* Like SetSize, but provides automatic resizing of parent control - (recursively). Especially useful for aligned controls. } - function SetClientSize( W, H: Integer ): PControl; - {* Like SetSize, but works setting W = ClientWidth, H = ClientHeight. - Use this method for forms, which can not be resized (dialogs). } - - {$ENDIF GDI} - function AutoSize( AutoSzOn: Boolean ): PControl; - {$IFDEF GDI} - function MakeWordWrap: PControl; - - {* Determines if to autosize control (like label, button, etc.) } - function IsAutoSize: Boolean; - {* TRUE, if a control is autosizing. } - function AlignLeft( P: PControl ): PControl; - {* assigns Left := P.Left } - function AlignTop( P: PControl ): PControl; - {* assigns Top := P.Top } - function ResizeParent: PControl; - {* Resizes parent, calling ResizeParentRight and ResizeParentBottom. } - function ResizeParentRight: PControl; - {* Resizes parent right edge (Margin of parent is added to right - coordinate of a control). If called second time (for the same - parent), resizes only for increasing of right edge of parent. } - - function ResizeParentBottom: PControl; - {* Resizes parent bottom edge (Margin of parent is added to - bottom coordinate of a control). } - function CenterOnParent: PControl; - {* Centers control on parent, or if applied to a form, centers - form on screen. } - - function Shift( dX, dY : Integer ): PControl; - {* Moves control respectively to current position (Left := Left + dX, - Top := Top + dY). } - {$ENDIF GDI} - function SetPosition( X, Y: Integer ): PControl; - {* Moves control directly to the specified position. } - {$IFDEF GDI} - - function Tabulate: PControl; - {* Call it once for form/applet to provide tabulation between controls on - form/on all forms using TAB / SHIFT+TAB and arrow keys. } - function TabulateEx: PControl; - {* Call it once for form/applet to provide tabulation between controls on - form/on all forms using TAB / SHIFT+TAB and arrow keys. Arrow keys are - used more smart, allowing go to nearest control in certain direction. } - - function SetAlign( AAlign: TControlAlign ): PControl; - {* Assigns passed value to property Align, aligning control on parent, - and returns @Self (so it is "transparent" function, which can be - used to adjust control at the creation, e.g.: - ! MyLabel := NewLabel( MyForm, 'Label1' ).SetAlign( caBottom ); - See also property Align. } - function PreventResizeFlicks: PControl; - {* If called, prevents resizing flicks for child controls, aligned to - right and bottom (but with a lot of code added to executable - about 3,5K). - There is sensible to set DoubleBuffered to True also to eliminate the - most of flicks. - |
    - This method been applied to a form, prevents, resizing flicks for - form and all controls on the form. If it is called for applet window, - all forms are affected. And if You want, You can apply it for certain - control only - in such case only given control and its children will - be resizing without flicks (e.g., using splitter control). } - - property Checked: Boolean read GetChecked write Set_Checked; - {* |<#checkbox> - |<#radiobox> - For checkbox and radiobox - if it is checked. Do not assign - value for radiobox - use SetRadioChecked instead. } - function SetChecked(const Value: Boolean): PControl; - {* |<#checkbox> - Use it to check/uncheck check box control or push button. - Do not apply it to check radio buttons - use SetRadioChecked - method below. } - function SetRadioChecked : PControl; - {* |<#radiobox> - Use it to check radio button item correctly (unchecking all - alternative ones). Actually, method Click is called, and control - itself is returned. } - function SetRadioCheckedOld: PControl; - {* |<#radiobox> - Old version of SetRadioChecked (implemented using recommended API - call. It does not work properly, if control is not visible - (together with its form). } - property Check3: TTriStateCheck read GetCheck3 write SetCheck3; - {* |<#checkbox> - State of checkbox with BS_AUTO3STATE style. } - procedure Click; - {* |<#button> - |<#checkbox> - |<#radiobox> - Emulates click on control programmatically, sending WM_COMMAND - message with BN_CLICKED code. This method is sensible only for - buttons, checkboxes and radioboxes. } - - function Perform( msgcode: DWORD; wParam, lParam: Integer): Integer; stdcall; - {* Sends message to control's window (created if needed). } - function Postmsg( msgcode: DWORD; wParam, lParam: Integer): Boolean; stdcall; - {* Sends message to control's window (created if needed). } - procedure AttachProc( Proc: TWindowFunc ); - {* It is possible to attach dynamically any message handler to window - procedure using this method. Last attached procedure is called first. - If procedure returns True, further processing of a message is stopped. - Attached procedure can be detached using DetachProc (but do not - attach/detach procedures during handling of attached procedure - - this can hang application). } - procedure AttachProcEx( Proc: TWindowFunc; ExecuteAfterAppletTerminated: Boolean ); - {* The same as AttachProc, but a handler is executed even after terminating - the main message loop processing (i.e. after assigning true to - AppletTerminated global variable. } - function IsProcAttached( Proc: TWindowFunc ): Boolean; - {* Returns True, if given procedure is already in chain of attached - ones for given control window proc. } - procedure DetachProc( Proc: TWindowFunc ); - {* Detaches procedure attached earlier using AttachProc. } - - property OnDropFiles: TOnDropFiles read FOnDropFiles write SetOnDropFiles; - {* Assign this event to your handler, if You want to accept drag and drop - files from other applications such as explorer onto your control. When - this event is assigned to a control or form, this has effect also for - all its child controls too. } - - property CustomData: Pointer read fCustomData write fCustomData; - {* Can be used to exend the object when new type of control added. Memory, - pointed by this pointer, released automatically in the destructor. } - property CustomObj: PObj read fCustomObj write fCustomObj; - {* Can be used to exend the object when new type of control added. Object, - pointed by this pointer, released automatically in the destructor. } - procedure SetAutoPopupMenu( PopupMenu: PObj ); - {* To assign a popup menu to the control, call SetAutoPopupMenu method of - the control with popup menu object as a parameter. } - - function SupportMnemonics: PControl; - {* This method provides supporting mnemonic keys in menus, buttons, checkboxes, - toolbar buttons. } - property OnScroll: TOnScroll read FOnScroll write SetOnScroll; - {* } - protected - {$IFDEF USE_DROPDOWNCOUNT} - fDropDownCount: Cardinal; - {$ENDIF} - fGraphCtlMouseEvent: TOnGraphCtlMouse; public - {$IFDEF USE_DROPDOWNCOUNT} - property DropDownCount: Cardinal read fDropDownCount write fDropDownCount; - {$ENDIF} + aAutoSzX: Byte; + aAutoSzY: Byte; protected - fPushedBtn: PControl; - fFocused: Boolean; - fEditOptions: TEditOptions; - fEditCtl: PControl; - fSetFocus: procedure of object; - fSaveCursor: HCursor; - fLeave: TOnEvent; - fKeyboardProcess: TOnMessage; - fHot: Boolean; - fPressed : Boolean; - fHotCtl: PControl; - fMouseLeaveProc: TOnEvent; - fIsGroupBox: Boolean; - fIsBitBtn: Boolean; - fIsSplitter: Boolean; - fErasingBkgnd: Boolean; - fButtonIcon: HIcon; - fActivating: Boolean; - fFixingModal: Integer; - {$IFDEF USE_GRAPHCTLS} - function DoGraphCtlPrepaint: TRect; - procedure GraphicLabelPaint( DC: HDC ); - procedure GraphicCheckBoxPaint( DC: HDC ); - procedure GraphicCheckBoxMouse( var Msg: TMsg ); - procedure GraphicRadioBoxPaint( DC: HDC ); - procedure GraphicButtonPaint( DC: HDC ); - procedure GraphicButtonMouse( var Msg: TMsg ); - procedure GraphButtonSetFocus; - function GraphButtonKeyboardProcess( var Msg: TMsg; var Rslt: Integer ): Boolean; - procedure LeaveGraphButton( Sender: PObj ); - procedure GraphicEditPaint( DC: HDC ); - procedure GraphicEditMouse( var Msg: TMsg ); - function EditGraphEdit: PControl; - procedure DestroyGraphEdit( Sender: PObj ); - procedure LeaveGraphEdit( Sender: PObj ); - procedure ChangeGraphEdit( Sender: PObj ); - procedure GraphEditboxSetFocus; - procedure GraphCtlDrawFocusRect( DC: HDC; const R: TRect ); - {$IFDEF GRAPHCTL_HOTTRACK} - procedure MouseLeaveFromParentOfGraphCtl( Sender: PObj ); - {$ENDIF GRAPHCTL_HOTTRACK} - procedure GroupBoxPaint( DC: HDC ); - {$ENDIF USE_GRAPHCTLS} - {$IFDEF KEY_PREVIEW} - protected - fKeyPreview: Boolean; - fKeyPreviewing: Boolean; - fKeyPreviewCount: Integer; - public - property KeyPreview: Boolean read fKeyPreview write fKeyPreview; - property KeyPreviewing: Boolean read fKeyPreviewing write fKeyPreviewing; - {$ENDIF KEY_PREVIEW} - protected - fAnchorLeft: Boolean; //+Sormart - fAnchorTop: Boolean; //+Sormart - fAnchorRight: Boolean; - fAnchorBottom: Boolean; - fOldWidth, fOldHeight: Integer; - procedure SetAnchorLeft(const Value: Boolean); //+Sormart - procedure SetAnchorTop(const Value: Boolean); //+Sormart - procedure SetAnchorRight( Value: Boolean ); - procedure SetAnchorBottom( Value: Boolean ); - public - property AnchorLeft: Boolean read fAnchorLeft write SetAnchorLeft default true; //+Sormart - property AnchorTop: Boolean read fAnchorTop write SetAnchorTop default true; //+Sormart - property AnchorRight: Boolean read fAnchorRight write SetAnchorRight; - 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} - // If an option USE_CUSTOMEXTENSIONS is enabled (at the beginning of this - // unit), You can freely extend TControl definition by your own fields, - // 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). - // 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 - // for TControl, CUSTOM_KOL_EXTENSION.inc, containing needed global - // declarations, and CUSTOM_CODE_EXTENSION.inc, the implementation of those - // two. - // Because KOL is always grow and constantly is extending by me, I also can - // add my own complements for TControl. To avoid naming conflicts, I suggest - // 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; - // last changes (1-Jul-06) from ECM [Michalichenko Eugeny, rest in peace, friend]: - //======== ListBox - private - function GetLBTopIndex: Integer; - procedure SetLBTopIndex(const Value: Integer); - public - function LBItemAtPos(X,Y: Integer): Integer; - {* |<#listbox> - Return index of item at the given position. } - property LBTopIndex: Integer read GetLBTopIndex write SetLBTopIndex; - {* |<#listbox> - Index of the first visible item in a list box} - //_________ + fAlign: TControlAlign; + fAligning:TAlignings; {$ENDIF GDI} + public + property Align: TControlAlign read FAlign write Set_Align; + {* Align style of a control. If this property is not used in your + application, there are no additional code added. Aligning of + controls is made in KOL like in VCL. To align controls when + initially create ones, use "transparent" function SetAlign + ("transparent" means that it returns @Self as a result). + |
+ Note, that it is better not to align combobox caClient, caLeft or + caRight (better way is to place a panel with Border = 0 and + EdgeStyle = esNone, align it as desired and to place a combobox on it + aligning caTop or caBottom). Otherwise, big problems could be under + Win9x/Me, and some delay could occur under any other systems. + |
Do not attempt to align some kinds of controls (like combobox) + caLeft or caRight, this can cause infinite recursion. } + property SizeRedraw: Boolean + read {$IFDEF USE_FLAGS} Get_SizeRedraw {$ELSE} fSizeRedraw {$ENDIF} + write {$IFDEF USE_FLAGS} Set_SizeRedraw {$ELSE} fSizeRedraw {$ENDIF}; + procedure ResetEvent( idx: Integer ); + {$IFDEF FINAL_MARKER} + protected + ffinal_offset: Boolean; + {$ENDIF} end; -//[END OF TControl DEFINITION] {$IFDEF USE_MHTOOLTIP} - {$DEFINE interface} + {$DEFINE interface_part} {$I KOLMHToolTip} - {$UNDEF interface} + {$UNDEF interface_part} {$ENDIF} +{$IFDEF EVENTS_DYNAMIC} +var EmptyEvents: TEvents; +{$ENDIF} + +function DummyProc123_TRUE( Dummy: Pointer; Sender: PControl; param3: Integer ): Boolean; +function DummyProc123_0( Dummy: Pointer; Sender: PObj; param3: Integer ): Integer; +function DummyProc4_TRUE( Dummy: Pointer; Sender: PControl; p3, p4: Integer ): Boolean; +function DummyProc5_TRUE( Dummy: Pointer; Sender: PControl; p3, p4, p5: Integer ): Boolean; +procedure DummyOnLVDataProc( Dummy: Pointer; Sender: PControl; Idx, SubItem: Integer; + var Txt: KOL_String; var ImgIdx: Integer; var State: DWORD; + var Store: Boolean ); +function DummyProc4_0( Dummy: Pointer; Sender: PControl; p3, p4: Integer ): Integer; +function DummyOnDrawItemProc( Dummy:Pointer; Sender: PObj; DC: HDC; const Rect: TRect; ItemIdx: Integer; + DrawAction: TDrawAction; ItemState: TDrawState ): Boolean; +function DummyOnLVCustomDrawProc( Dummy: Pointer; Sender: PControl; DC: HDC; Stage: DWORD; + ItemIdx, SubItemIdx: Integer; const Rect: TRect; + ItemState: TDrawState; var TextColor, BackColor: TColor ): DWORD; +function DummyOnSBBeforeScrollProc(Dummy: Pointer; Sender: PControl; + OldPos, NewPos: Integer; Cmd: Word; var AllowChange: Boolean): Boolean; + +{$IFDEF USE_GRAPHCTLS} +procedure InvalidateWindowed( Sender: PObj ); +procedure InvalidateNonWindowed( Sender: PObj ); +{$ENDIF} + +function FormNewLabel( Form: PControl ): PControl; +function FormNewWordWrapLabel( Form: PControl ): PControl; +function FormNewLabelEffect( Form: PControl ): PControl; +function FormNewButton( Form: PControl ): PControl; +function FormNewBitBtn( Form: PControl ): PControl; +function FormNewPanel( Form: PControl ): PControl; +function FormNewGradientPanel( Form: PControl ): PControl; +function FormNewGradientPanelEx( Form: PControl ): PControl; +function FormNewGroupbox( Form: PControl ): PControl; +function FormNewPaintbox( Form: PControl ): PControl; +function FormNewEditBox( Form: PControl ): PControl; +{$IFDEF USE_RICHEDIT} +function FormNewRichEdit( Form: PControl ): PControl; +{$ENDIF} +function FormNewCombobox( Form: PControl ): PControl; +function FormNewCheckbox( Form: PControl ): PControl; +function FormNewRadiobox( Form: PControl ): PControl; +function FormNewSplitter( Form: PControl ): PControl; +function FormNewListbox( Form: PControl ): PControl; +function FormNewListView( Form: PControl ): PControl; +function FormNewTreeView( Form: PControl ): PControl; +function FormNewScrollbox( Form: PControl ): PControl; +function FormNewScrollboxEx( Form: PControl ): PControl; +function FormNewScrollBar( Form: PControl ): PControl; +function FormNewProgressBar( Form: PControl ): PControl; +function FormNewProgressBarEx( Form: PControl ): PControl; +//function FormNewToolbar( Form: PControl ): PControl; +function FormNewDateTimePicker( Form: PControl ): PControl; +{$IFDEF _D4orHigher} +function FormNewTabControl( Form: PControl ): PControl; +{$ENDIF} + +procedure FormSetSize( Form: PControl ); +procedure FormSetHeight( Form: PControl ); +procedure FormSetWidth( Form: PControl ); +procedure FormSetPosition( Form: PControl ); +procedure FormSetClientSize( Form: PControl ); +procedure FormSetAlign( Form: PControl ); +{$IFDEF USE_NAMES} +procedure FormSetName( Form: PControl ); +{$ENDIF USE_NAMES} +{$IFDEF UNICODE_CTRLS} +procedure FormSetUnicode( Form: PControl ); +{$ENDIF UNICODE_CTRLS} +procedure FormAssignHelpContext( Form: PControl ); +procedure FormSetCanResizeFalse( Form: PControl ); +procedure FormInitMenu( Form: PControl ); + +procedure FormSizeGripFalse( Form: PControl ); +procedure FormSetExStyle( Form: PControl ); +procedure FormSetVisibleFalse( Form: PControl ); +procedure FormSetEnabledFalse( Form: PControl ); +procedure FormResetStyles( Form: PControl ); +procedure FormSetStyle( Form: PControl ); +procedure FormSetAlphaBlend( Form: PControl ); +procedure FormSetHasBorderFalse( Form: PControl ); +procedure FormSetHasCaptionFalse( Form: PControl ); +procedure FormResetCtl3D( Form: PControl ); +procedure FormIconLoad_hInstance( Form: PControl ); +procedure FormIconLoadCursor_0( Form: PControl ); +procedure FormSetIconNeg1( Form: PControl ); +procedure FormIconLoad_hInstance_str( Form: PControl ); +procedure FormSetWindowState( Form: PControl ); +procedure FormCursorLoad_0( Form: PControl ); +procedure FormCursorLoad_hInstance( Form: PControl ); +procedure FormSetColor( Form: PControl ); +procedure FormSetBrushStyle( Form: PControl ); +procedure FormSetBrushBitmap( Form: PControl ); +procedure FormSetFontColor( Form: PControl ); +procedure FormSetFontStyles( Form: PControl ); +procedure FormSetFontHeight( Form: PControl ); +procedure FormSetFontWidth( Form: PControl ); +procedure FormSetFontName( Form: PControl ); +procedure FormSetFontOrientation( Form: PControl ); +procedure FormSetFontCharset( Form: PControl ); +procedure FormSetFontPitch( Form: PControl ); +procedure FormSetBorder( Form: PControl ); +procedure FormSetMarginTop( Form: PControl ); +procedure FormSetMarginBottom( Form: PControl ); +procedure FormSetMarginLeft( Form: PControl ); +procedure FormSetMarginRight( Form: PControl ); +procedure FormSetSimpleStatusText( Form: PControl ); +procedure FormSetStatusText( Form: PControl ); +procedure FormRemoveCloseIcon( Form: PControl ); +procedure FormSetEraseBkgndTrue( Form: PControl ); +procedure FormSetMinWidth( Form: PControl ); +procedure FormSetMaxWidth( Form: PControl ); +procedure FormSetMinHeight( Form: PControl ); +procedure FormSetMaxHeight( Form: PControl ); +{$IFDEF KEY_PREVIEW} +procedure FormSetKeyPreviewTrue( Form: PControl ); +{$ENDIF} +// BitBtn only: +procedure FormSetRepeatInterval( Form: PControl ); +procedure FormSetTextShiftX( Form: PControl ); +procedure FormSetTextShiftY( Form: PControl ); +// LabelEffect only: +procedure FormSetColor2( Form: PControl ); + +procedure FormSetTextAlign( Form: PControl ); +procedure FormSetTextVAlign( Form: PControl ); +procedure FormSetTabStopFalse( Form: PControl ); +procedure FormSetIgnoreDefault( Form: PControl ); +procedure FormSetHintText( Form: PControl ); +procedure FormSetAnchor( Form: PControl ); +procedure FormSetCaption( Form: PControl ); +procedure FormSetGradienStyle( Form: PControl ); +procedure FormOverrideScrollbars( Form: PControl ); +// RichEdit only: +{$IFDEF USE_RICHEDIT} +procedure FormSetRE_AutoFontFalse( Form: PControl ); +procedure FormSetRE_AutoFontSizeAdjustFalse( Form: PControl ); +procedure FormSetRE_DualFontTrue( Form: PControl ); +procedure FormSetRE_UIFontsTrue( Form: PControl ); +procedure FormSetRE_IMECancelCompleteTrue( Form: PControl ); +procedure FormSetRE_IMEAlwaysSendNotifyTrue( Form: PControl ); +procedure FormSetMaxTextSize( Form: PControl ); +procedure FormSetRE_AutoKeyboardTrue( Form: PControl ); +procedure FormSetRE_DisableOverwriteChangeTrue( Form: PControl ); +procedure FormSetRE_Zoom( Form: PControl ); +{$ENDIF USE_RICHEDIT} +procedure FormSetListItems( Form: PControl ); +procedure FormSetCount( Form: PControl ); +procedure FormSetDroppedWidth( Form: PControl ); +procedure FormSetButtonIcon( Form: PControl ); +procedure FormSetButtonImage( Form: PControl ); +procedure FormSetButtonBitmap( Form: PControl ); +// progress +procedure FormSetMaxProgress( Form: PControl ); +procedure FormSetProgress( Form: PControl ); +// list view +procedure FormLVColumsAdd( Form: PControl ); +procedure FormSetLVColOrder( Form: PControl ); +procedure FormSetLVColImage( Form: PControl ); +// tree view +procedure FormSetTVIndent( Form: PControl ); +// toolbar +procedure FormSetTBBtnImgWidth( Form: PControl ); +procedure FormTBAddBitmap( Form: PControl ); +procedure FormSetTBButtonSize( Form: PControl ); +{$IFDEF _D4orHigher} +procedure FormTBSetTooltips( Form: PControl ); +{$ENDIF} +procedure FormSetTBButtonsMinWidth( Form: PControl ); +procedure FormSetTBButtonsMaxWidth( Form: PControl ); +procedure FormHideToolbarButton( Form: PControl ); +procedure FormDisableToolbarButton( Form: PControl ); +procedure FormFixFlatXPToolbar( Form: PControl ); +// datetimepicker +procedure FormSetDateTimeFormat( Form: PControl ); +procedure FormSetDateTimeColor( Form: PControl ); +// tabcontrol +procedure FormSetCurrentTab( Form: PControl ); +procedure FormSetCurIdx( Form: PControl ); +// scrolbar +procedure FormSetSBMin( Form: PControl ); +procedure FormSetSBMax( Form: PControl ); +procedure FormSetSBPosition( Form: PControl ); +procedure FormSetSBPageSize( Form: PControl ); + + +procedure FormLastCreatedChildAsNewCurrentParent( Form: PControl ); +procedure FormSetUpperParent( Form: PControl ); +procedure FormSetTabpageAsParent( Form: PControl ); + +procedure FormSetCurCtl( Form: PControl ); +procedure FormSetParent( Form: PControl ); +procedure FormSetEvent( Form: PControl ); +procedure FormSetIndexedEvent( Form: PControl ); + + {$IFDEF WIN_GDI} function ToolbarButtonRect( Toolbar: PControl; BtnID: Integer ): TRect; {* Use this function instead of reading TControl.TBButtonRect, if you want @@ -8880,6 +9573,9 @@ function ToolbarButtonChecked( Toolbar: PControl; BtnID: Integer): Boolean; {* } procedure ToolbarButtonSetChecked( Toolbar: PControl; BtnID: Integer; Checked: Boolean ); {* } +procedure ToolbarAddButtons( Toolbar: PControl; const Buttons: array of PKOLChar; + const BtnImgIdxArray: array of Integer; Bitmap: HBitmap ); +{* } function Scrollbar_GetMinPos( sb: PControl ): Integer; procedure Scrollbar_SetMinPos( sb: PControl; m: Integer ); @@ -8896,7 +9592,6 @@ function Scrollbar_GetLineSz( sb: PControl ): Integer; var ToolbarsIDcmd: Integer = 100; -//[Paint Background PROCEDURE] type TOnPaintBkgnd = procedure( Sender: PControl; DC: HDC; Rect: PRect ); {* Global event definition. Used to define Global_OnPaintBackground @@ -8913,14 +9608,10 @@ var | Wei Bao. Implementation: | Kladov Vladimir. } -procedure DummyPaintProc( Sender: PControl; DC: HDC ); - -//[GetShiftState DECLARATION] function GetShiftState: DWORD; {* Returns shift state. } {$IFDEF WIN_GDI} -//[WndProcXXX DECLARATIONS] function WndProcMouse( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; function WndProcKeybd( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; function WndProcDummy( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; @@ -8929,15 +9620,13 @@ function WndProcMenu( Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boole function WndProcBtnReturnClick( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; {$ENDIF} function AutoMinimizeApplet(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; -{* By Sergey Shishmintzev. +{* By Sergey Shishmintzev Attach this handler to your modal dialog form handle to provide automatic minimization of all other forms in the application together with the dialog. } -//[InitCommonXXXX DECLARATIONS] procedure InitCommonControlSizeNotify( Ctrl: PControl ); procedure InitCommonControlCommonNotify( Ctrl: PControl ); -//[Buffered Draw DECLARATIONS] procedure DummyAttachProcExtension ( DynHandlers: PList ); procedure TransparentAttachProcExtension ( DynHandlers: PList ); @@ -8945,15 +9634,14 @@ procedure TransparentAttachProcExtension ( DynHandlers: PList ); var Global_AttachProcExtension: procedure( DynHandlers: PList ) = DummyAttachProcExtension; {$ENDIF} {$ENDIF WIN_GDI} -var HelpFilePath: PAnsiChar; +var HelpFilePath: PKOLChar; {* Path to application help file. If not assigned, application path with extension replaced to '.hlp' used. To use '.chm' file (HtmlHelp), call AssignHtmlHelp with a path to a html help file (or a name). } {$IFDEF WIN_GDI} -//[Html Help DECLARATIONS] procedure AssignHtmlHelp( const HtmlHelpPath: KOLString ); -procedure HtmlHelpCommand( Wnd: HWnd; const HelpFilePath: AnsiString; Cmd, Data: Integer ); +procedure HtmlHelpCommand( Wnd: HWnd; const HelpFilePath: KOLString; Cmd, Data: Integer ); {* Use this wrapper procedure to call HtmlHelp API function. } //+++++++++++ HTML HELP DEFINITIONS SECTION: // this section is from @@ -9359,29 +10047,14 @@ const HH_GPROPID_CONTENT_LANGUAGE = 5; // long: LandId for desired content. type - tagHH_GPROPID = HH_GPROPID_SINGLETHREAD..HH_GPROPID_CONTENT_LANGUAGE; //tagHH_GPROPID, HH_GPROPID + tagHH_GPROPID = HH_GPROPID_SINGLETHREAD..HH_GPROPID_CONTENT_LANGUAGE; HH_GPROPID = tagHH_GPROPID; THHGPropID = HH_GPROPID; -/////////////////////////////////////////////////////////////////////////////// -// -// Global Property structure -// -{type - PHHGlobalProperty = ^THHGlobalProperty; - tagHH_GLOBAL_PROPERTY = record //tagHH_GLOBAL_PROPERTY, HH_GLOBAL_PROPERTY - id: THHGPropID; - Dummy: Integer; // Added to enforce 8-byte packing - var_: VARIANT; - end; - HH_GLOBAL_PROPERTY = tagHH_GLOBAL_PROPERTY; - THHGlobalProperty = tagHH_GLOBAL_PROPERTY;} -//[END OF HTMLHELP DECLARATIONS] {$ENDIF WIN_GDI} {$IFDEF WIN_GDI} -//[GetCtlBrush DECLARATIONS] -function SimpleGetCtlBrushHandle( Sender: PControl ): HBrush; +function SimpleGetCtlBrushHandle( Sender: PControl ): HBrush; var Global_GetCtlBrushHandle: function( Sender: PControl ): HBrush = SimpleGetCtlBrushHandle; @@ -9393,7 +10066,6 @@ var is changed for TControl, or SetAlign method is called for it. } {$IFDEF WIN_GDI} -//[WndFunc DECLARATION] function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer ) : Integer; stdcall; {* Global message handler for window. Redirects all messages to @@ -9401,7 +10073,6 @@ function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer ) window itself, using GetProp API call. } {$ENDIF WIN_GDI} //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -//[Applet VARIABLES] var AppletRunning: Boolean; {* Is set to True while message loop is processing (in Run procedure). } AppletTerminated: Boolean; @@ -9417,7 +10088,6 @@ var AppletRunning: Boolean; (always visible). } {$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -//[Screen DECLARATIONS] ScreenCursor: HCursor; {* Set this global variable to override any cursor settings of current form or control. } @@ -9427,7 +10097,6 @@ function ScreenWidth: Integer; function ScreenHeight: Integer; {* Returns screen height in pixels. } -//[Status DECLARATIONS] type TStatusOption = ( soNoSizeGrip, soTop ); {* Options available for status bars. } @@ -9437,6 +10106,9 @@ type procedure DrawFormattedText( Ctl: PControl; DC: HDC; var R: TRect; Flags: DWORD {EditCtl: Boolean} ); {* This procedure can be useful to draw control's text in custom-defined controls. } +type TCommandActionsParam = {$IFDEF PACK_COMMANDACTIONS} PAnsiChar + {$ELSE} PCommandActions {$ENDIF}; + {$IFDEF USE_GRAPHCTLS} {$IFDEF GRAPHCTL_XPSTYLES} @@ -9446,7 +10118,8 @@ procedure DrawFormattedTextXP( Theme: THandle; Ctl: PControl; DC: HDC; {* This procedure can be useful to draw control's text in custom-defined controls. } {$ENDIF} -function _NewGraphCtl( AParent: PControl; ATabStop: Boolean ): PControl; +function _NewGraphCtl( AParent: PControl; ATabStop: Boolean; + ACommandActions: TCommandActionsParam ): PControl; {* Creates graphic control basics. } function NewGraphLabel( AParent: PControl; const ACaption: AnsiString ): PControl; @@ -9474,7 +10147,6 @@ function NewGraphEditbox( AParent: PControl; Options: TEditOptions ): PControl; {$ENDIF USE_GRAPHCTLS} {$ENDIF WIN_GDI} -//[Run DECLARATION] procedure Run( var AppletWnd: PControl ); {* |<#appbutton> Call this procedure to process messages loop of your program. @@ -9493,7 +10165,6 @@ procedure Run( var AppletWnd: PControl ); procedure TerminateExecution( var AppletWnd: PControl ); -//[Applet FUNCTIONS DECLARATIONS] procedure AppletMinimize; {* Minimizes the application (Applet should be assigned to have effect). } procedure AppletHide; @@ -9501,7 +10172,6 @@ procedure AppletHide; procedure AppletRestore; {* Restores Applet when minimized. } -//[Idle handler DECALRATIONS] {YS+} procedure RegisterIdleHandler( const OnIdle: TOnEvent ); {* Registers new Idle handler. Idle handler is called each time when @@ -9510,8 +10180,6 @@ procedure UnRegisterIdleHandler( const OnIdle: TOnEvent ); {* Unregisters Idle handler. } {YS-} -//[InitCommonXXXX ANOTHER DECLARATIONS] - {* ComCtrl32 controls initialization. } procedure InitCommonControls; stdcall; procedure DoInitCommonControls( dwICC: DWORD ); @@ -9553,7 +10221,6 @@ const ICC_PAGESCROLLER_CLASS = $00001000; // page scroller ICC_NATIVEFNTCTL_CLASS = $00002000; // native font control -//[Ole DECLARATIONS] function OleInit: Boolean; {* Calls OleInitialize (once - all other calls are simulated by incrementing call counter. Every OleInit shoud be complemented with correspondent OleUninit. @@ -9562,32 +10229,33 @@ function OleInit: Boolean; procedure OleUnInit; {* Decrements counter and calls OleUnInitialize when it is zeroed. } var OleInitCount: Integer; -{-} function StringToOleStr(const Source: Ansistring): PWideChar; {* } -{+} function SysAllocStringLen(psz: PWideChar; len: Integer): PWideChar; stdcall; procedure SysFreeString( psz: PWideChar ); stdcall; {$ENDIF WIN_GDI} { -- Contructors for visual controls -- } -//[NewXXXX DECLARATIONS] -//[_NewWindowed DECLARATION] {$IFDEF GDI} -function _NewWindowed( AParent: PControl; ControlClassName: PKOLChar; Ctl3D: Boolean ): PControl; +{$IFDEF COMMANDACTIONS_OBJ} +function NewCommandActionsObj: PCommandActionsObj; +function NewCommandActionsObj_Packed( fromPack: PAnsiChar ): PCommandActionsObj; +{$ENDIF} + +function _NewWindowed( AParent: PControl; ControlClassName: PKOLChar; + Ctl3D: Boolean; ACommandActions: TCommandActionsParam): PControl; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function _NewWindowed( AParent: PControl; ControlClassName: PAnsiChar; +FUNCTION _NewWindowed( AParent: PControl; ControlClassName: PAnsiChar; widget: PGtkWidget; need_eventbox: Boolean ): PControl; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -//[NewApplet DECLARATION] function NewApplet( const Caption: KOLString ): PControl; {* |<#control> Creates applet button window, which has to be parent of all other forms @@ -9596,9 +10264,8 @@ function NewApplet( const Caption: KOLString ): PControl; Following methods, properties and events are useful to work with applet control: |#appbutton } - {$ENDIF WIN_GDI} -//[NewForm DECLARATION] + function NewForm( AParent: PControl; const Caption: KOLString ): PControl; {* |<#control> Creates form window object and returns pointer to it. If You use only one form, @@ -9617,19 +10284,17 @@ function NewForm( AParent: PControl; const Caption: KOLString ): PControl; function NewAlienPanel( AParentWnd: HWnd; EdgeStyle: TEdgeStyle ): PControl; -//[_NewControl DECLARATION] {$IFDEF GDI} function _NewControl( AParent: PControl; ControlClassName: PKOLChar; - Style: DWORD; Ctl3D: Boolean; Actions: PCommandActions ): PControl; + Style: DWORD; Ctl3D: Boolean; Actions: TCommandActionsParam ): PControl; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function _NewControl( AParent: PControl; ControlClassName: PAnsiChar; +FUNCTION _NewControl( AParent: PControl; ControlClassName: PAnsiChar; Style: DWORD; Ctl3D: Boolean; widget: PGtkWidget; need_eventbox: Boolean ): PControl; {$ENDIF GTK} {$ENDIF _X_} -//[NewButton DECLARATION] function NewButton( AParent: PControl; const Caption: KOLString ): PControl; {* |<#control> Creates button on given parent control or form. @@ -9640,7 +10305,6 @@ function NewButton( AParent: PControl; const Caption: KOLString ): PControl; |#button } {$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -//[NewBitBtn DECLARATION] function NewBitBtn( AParent: PControl; const Caption: KOLString; Options: TBitBtnOptions; Layout: TGlyphLayout; GlyphBitmap: HBitmap; GlyphCount: Integer ): PControl; {* |<#control> @@ -9677,7 +10341,6 @@ function NewBitBtn( AParent: PControl; const Caption: KOLString; |#bitbtn } {$ENDIF GDI} -//[NewLabel DECLARATION] function NewLabel( AParent: PControl; const Caption: KOLString ): PControl; {* |<#control> Creates static text control (native Windows STATIC control). @@ -9689,7 +10352,6 @@ function NewLabel( AParent: PControl; const Caption: KOLString ): PControl; |#label } {$IFDEF GDI} -//[NewWordWrapLabel DECLARATION] function NewWordWrapLabel( AParent: PControl; const Caption: KOLString ): PControl; {* |<#control> Creates multiline static text control (native Windows STATIC control), @@ -9698,7 +10360,6 @@ function NewWordWrapLabel( AParent: PControl; const Caption: KOLString ): PContr |#wwlabel |#label } -//[NewLabelEffect DECLARATION] function NewLabelEffect( AParent: PControl; const Caption: KOLString; ShadowDeep: Integer ): PControl; {* |<#control> Creates 3D-label with capability to rotate its text , which @@ -9711,7 +10372,6 @@ function NewLabelEffect( AParent: PControl; const Caption: KOLString; ShadowDeep |#label } {$ENDIF GDI} -//[NewPaintbox DECLARATION] function NewPaintbox( AParent: PControl ): PControl; {* |<#control> Creates owner-drawn STATIC control. Set its event to @@ -9719,7 +10379,6 @@ function NewPaintbox( AParent: PControl ): PControl; |#paintbox } {$IFDEF GDI} -//[NewImageShow DECLARATION] function NewImageShow( AParent: PControl; AImgList: PImageList; ImgIdx: Integer ): PControl; {* |<#control> Creates an image show control, implemented as a paintbox which is used to @@ -9728,12 +10387,10 @@ function NewImageShow( AParent: PControl; AImgList: PImageList; ImgIdx: Integer use another image list. When the control is created, its size becomes equal to dimensions of imagelist (if any). } -//[NewScrollBar DECLARATION] function NewScrollBar( AParent: PControl; BarSide: TScrollerBar ): PControl; {* |<#control> Creates simple scroll bar. } -//[NewScrollBox DECLARATION] function NewScrollBox( AParent: PControl; EdgeStyle: TEdgeStyle; Bars: TScrollerBars ): PControl; {* |<#control> @@ -9748,7 +10405,6 @@ function NewScrollBoxEx( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl; Creates extended scrolling box control, which automatically scrolls child controls (if any). } -//[NewGradientPanel DECLARATION] function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl; {* |<#control> Creates gradient-filled STATIC control. To adjust colors at the @@ -9765,14 +10421,12 @@ function NewGradientPanelEx( AParent: PControl; Color1, Color2: TColor; to repaint control. Depending on style and first line/point layout, can looking different. Idea: Vladimir Stojiljkovic. } -//[NewPanel DECLARATION] function NewPanel( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl; {* |<#control> Creates panel, which can be parent for other controls (though, any control can be used as a parent for other ones, but panel is specially designed for such purpose). } -//[NewMDIxxx DECLARATIONS] function NewMDIClient( AParent: PControl; WindowMenu: THandle ): PControl; {* |<#control> Creates MDI client window, which is a special type of child window, @@ -9789,7 +10443,6 @@ function NewMDIChild( AParent: PControl; const ACaption: KOLString ): PControl; Creates MDI client window. AParent should be a MDI client window, created with NewMDIClient function. } -//[NewSplitter DECLARATIONS] function NewSplitter( AParent: PControl; MinSizePrev, MinSizeNext: Integer ): PControl; {* |<#control> Creates splitter control, which will separate previous one (i.e. last @@ -9837,14 +10490,12 @@ function NewSplitterEx( AParent: PControl; MinSizePrev, MinSizeNext: Integer; Creates splitter control. Difference from NewSplitter is what it is possible to determine if a splitter will be beveled or not. See also NewSplitter. } -//[NewGroupbox DECLARATION] function NewGroupbox( AParent: PControl; const Caption: KOLString ): PControl; {* |<#control> Creates group box control. Note, that to group radio items, group box is not necessary - any parent can play role of group for radio items. See also NewPanel. } -//[NewCheckbox DECLARATION] function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl; {* |<#control> Creates check box control. Special properties, methods, events: @@ -9856,7 +10507,6 @@ function NewCheckBox3State( AParent: PControl; const Caption: KOLString ): PCont events: |#checkbox } -//[NewRadiobox DECLARATION] function NewRadiobox( AParent: PControl; const Caption: KOLString ): PControl; {* |<#control> Creates radio box control. Alternative radio items must have the @@ -9865,7 +10515,6 @@ function NewRadiobox( AParent: PControl; const Caption: KOLString ): PControl; are specially for radiobox controls: |#radiobox } -//[NewEditbox DECLARATION] function NewEditbox( AParent: PControl; Options: TEditOptions ): PControl; {* |<#control> Creates edit box control. To create multiline edit box, similar to @@ -9885,7 +10534,6 @@ const RichEditLibnames: array[ 0..3 ] of PKOLChar = 'RichEdit', 'RichEdit' ); var RichEditIdx: Byte = High( RichEditLibnames ); -//[NewRichEdit DECLARATION] function NewRichEdit( AParent: PControl; Options: TEditOptions ): PControl; {* |<#control> Creates rich text edit control. A rich edit control is a window in which @@ -9914,14 +10562,12 @@ function NewRichEdit1( AParent: PControl; Options: TEditOptions ): PControl; of RichEdit could not working. } {$ENDIF NOT_USE_RICHEDIT} -//[NewListbox DECLARATION] function NewListbox( AParent: PControl; Options: TListOptions ): PControl; {* |<#control> Creates list box control. Following properties, methods and events are special for Listbox: |#listbox } -//[NewCombobox DECLARATION] function NewCombobox( AParent: PControl; Options: TComboOptions ): PControl; {* |<#control> Creates new combo box control. Note, that it is not possible to align @@ -9931,11 +10577,10 @@ function NewCombobox( AParent: PControl; Options: TComboOptions ): PControl; special for Combobox: |#combo } -//[_NewCommonControl DECLARATION] function _NewCommonControl( AParent: PControl; ClassName: PKOLChar; Style: DWORD; - Ctl3D: Boolean; Actions: PCommandActions ): PControl; + Ctl3D: Boolean; Actions: TCommandActionsParam + ): PControl; -//[NewProgressbar DECLARATION] function NewProgressbar( AParent: PControl ): PControl; {* |<#control> Creates progress bar control. Following properties are special for @@ -9949,7 +10594,6 @@ function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PC onto bricks) or/and vertical progress bar - using additional parameter. For list of properties, suitable for progress bars, see NewProgressbar. } -//[NewListVew DECLARATION] function NewListView( AParent: PControl; Style: TListViewStyle; Options: TListViewOptions; ImageListSmall, ImageListNormal, ImageListState: PImageList ): PControl; {* |<#control> @@ -9958,14 +10602,12 @@ function NewListView( AParent: PControl; Style: TListViewStyle; Options: TListVi methods and events, special for list view control are: |#listview } -//[NewTreeView DECLARATION] function NewTreeView( AParent: PControl; Options: TTreeViewOptions; ImgListNormal, ImgListState: PImageList ): PControl; {* |<#control> Creates tree view control. See tree view methods and properties: |#treeview } -//[NewTabControl DECLARATION] function NewTabControl( AParent: PControl; const Tabs: array of PKOLChar; Options: TTabControlOptions; ImgList: PImageList; ImgList1stIdx: Integer ): PControl; {* |<#control> @@ -9994,7 +10636,9 @@ function NewTabEmpty( AParent: PControl; Options: TTabControlOptions; or TC_InsertControl (if you want using your custom Pages).} {$ENDIF} -//[NewToolbar DECLARATION] +var ToolbarDfltWidth: WORD = 1000; + ToolbarDfltHeight: WORD = 26; + function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions; Bitmap: HBitmap; const Buttons: array of PKOLChar; const BtnImgIdxArray: array of Integer ) : PControl; @@ -10046,7 +10690,6 @@ function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarO above about Bitmap become absolutely incorrect. } -//[NewDateTimePicker DECLARATION] function NewDateTimePicker( AParent: PControl; Options: TDateTimePickerOptions ) : PControl; {* |<#control> @@ -10055,7 +10698,6 @@ function NewDateTimePicker( AParent: PControl; Options: TDateTimePickerOptions ) { -- Constructor for Image List objet -- } -//[NewImageList DECLARATION] function NewImageList( AOwner: PControl ): PImageList; {* Constructor of TImageList object. Unlike other non-visual objects, image list can be parented by TControl object (but this does not *must*), and in that @@ -10066,15 +10708,12 @@ function NewImageList( AOwner: PControl ): PImageList; {$ENDIF WIN_GDI} -//[TIMER] type TTimerKind = ( tkReal, tkProcess, tkProfiler ); // only for UNIX! - {++}(*TTimer = class;*){--} - PTimer = {-}^{+}TTimer; + PTimer = ^TTimer; { ---------------------------------------------------------------------- TTimer object ----------------------------------------------------------------------- } -//[TTimer DEFINITION] TTimer = object( TObj ) {* Easy timer incapsulation object. It uses separate topmost window, common for all timers in the application, to handle WM_TIMER message. @@ -10104,8 +10743,7 @@ type procedure SetEnabled(const Value: Boolean); {$IFDEF WIN} virtual; {$ENDIF} procedure SetInterval(const Value: Integer); protected - {++}(*public*){--} - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* Destructor. } public property Handle : Integer read fHandle; @@ -10127,19 +10765,14 @@ type {$ENDIF GTK} {$ENDIF LIN} end; -//[END OF TTimer DEFINITION] -//[NewTimer DECLARATION] function NewTimer( Interval: Integer ): PTimer; {* Constructs initially disabled timer with interval 1000 (1 second). } {$IFDEF WIN} -//[MULTIMEDIA TIMER] type - {++}(*TMMTimer = class;*){--} - PMMTimer = {-}^{+}TMMTimer; + PMMTimer = ^TMMTimer; -//[TMMTimer DEFINITION] TMMTimer = object( TTimer ) {* Multimedia timer incapsulation object. Does not require Applet or special window to handle it. System creates a thread for each high resolution @@ -10147,9 +10780,9 @@ type protected FResolution: Integer; FPeriodic: Boolean; - procedure SetEnabled(const Value: Boolean); {-}virtual;{+}{++}(*override;*){--} + procedure SetEnabled(const Value: Boolean); virtual; public - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* } property Resolution: Integer read FResolution write FResolution; {* Minimum timer resolution. The less the more accuracy (0 is exactly @@ -10162,9 +10795,7 @@ type (set it Enabled every time in such case for each shot). If you change this property, reset and set Enabled property again to get effect. } end; -//[END OF TMMTimer DEFINITION] -//[NewMMTimer DECLARATION] function NewMMTimer( Interval: Integer ): PMMTimer; {* Creates multimedia timer object. Initially, it has Resolution = 0, Periodic = TRUE and Enabled = FALSE. Do not forget also to assign your @@ -10177,19 +10808,16 @@ function NewMMTimer( Interval: Integer ): PTimer; {$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv { -- TTrayIcon object -- } -//[TRAYICON] type TOnTrayIconMouse = procedure( Sender: PObj; Message : Word ) of object; {* Event type to be called when Applet receives a message from an icon, added to the taskbar tray. } - {++}(*TTrayIcon = class;*){--} - PTrayIcon = {-}^{+}TTrayIcon; + PTrayIcon = ^TTrayIcon; { ---------------------------------------------------------------------- TTrayIcon - icon in tray area of taskbar ----------------------------------------------------------------------- } -//[TTrayIcon DEFINITION] TTrayIcon = object(TObj) {* Object to place (and change) a single icon onto taskbar tray. } protected @@ -10207,8 +10835,7 @@ type procedure SetTooltip(const Value: KOLString); procedure SetAutoRecreate(const Value: Boolean); protected - {++}(*public*){--} - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* Destructor. Use Free method instead (as usual). } public property Icon : HIcon read FIcon write SetIcon; @@ -10300,21 +10927,18 @@ type потребуется, используйте отдельный представитель класса TControl - глобальную переменную Applet, и присвойте FALSE ее свойству Visible. } -//[END OF TTrayIcon DEFINITION] -//[NewTrayIcon DECLARATION] function NewTrayIcon( Wnd: PControl; Icon: HIcon ): PTrayIcon; {* Constructor of TTrayIcon object. Pass main form or applet as Wnd parameter. } -//[JUST ONE] { -- JustOne -- } type TOnAnotherInstance = procedure( const CmdLine: KOLString ) of object; {* Event type to use in JustOneNotify function. } -function JustOne( Wnd: PControl; const Identifier : AnsiString ) : Boolean; +function JustOne( Wnd: PControl; const Identifier : KOLString ) : Boolean; {* Returns True, if this is a first instance. For all other instances (application is already running), False is returned. } @@ -10329,7 +10953,6 @@ function JustOneNotify( Wnd: PControl; const Identifier : KOLString; { -- string (mainly) utility procedures and functions. -- } {$IFDEF GDI} -//[Message Box DECLARATIONS] function MsgBox( const S: KOLString; Flags: DWORD ): DWORD; {* Displays message box with the same title as Applet.Caption. If applet is not running, and Applet global variable is not assigned, caption @@ -10353,10 +10976,6 @@ procedure SpeakerBeep( Freq: Word; Duration: DWORD ); of desired frequency during given duration time (in milliseconds). } {$ENDIF WIN} -{++}(* -function FormatMessage(dwFlags: DWORD; lpSource: Pointer; dwMessageId: DWORD; dwLanguageId: DWORD; - lpBuffer: PAnsiChar; nSize: DWORD; Arguments: Pointer): DWORD; stdcall; -*){--} function SysErrorMessage(ErrorCode: Integer): KOLString; {* Creates and returns a string containing formatted system error message. It is possible then to display this message or write it to a log @@ -10367,7 +10986,6 @@ function SysErrorMessage(ErrorCode: Integer): KOLString; } {$ENDIF WIN_GDI} -//[I64 TYPE] type I64 = record {* 64 bit integer record. Use it and correspondent functions below in KOL @@ -10378,7 +10996,6 @@ type PI64 = ^I64; {* } -{-} {$IFNDEF _D4orHigher} Int64 = I64; PInt64 = PI64; @@ -10437,38 +11054,28 @@ function Double2Int64( D: Double ): I64; const NAN = 0.0 / 0.0; Infinity = 1.0 / 0.0; -{+} - {++}(*const NAN = 1e-100;*){--} function IsNan(const AValue: Double): Boolean; {* Checks if an argument passed is NAN. } function IsInfinity(const AValue: Double): Boolean; {* Checks if an argument passed is Infinite. } - function IntPower(Base: Extended; Exponent: Integer): Extended; {* Result := Base ^ Exponent; } - function NextPowerOf2( n: DWORD ): DWORD; {* 0->1, 1->1, 2->2, 3->4, 4->4, 5->8, ... } - -//[String<->Double DECLARATIONS] -function Str2Double( const S: AnsiString ): Double; +function Str2Double( const S: KOLString ): Double; {* } - -function Str2Extended( const S: AnsiString ): Extended; +function Str2Extended( const S: KOLString ): Extended; {* } - -function Double2Str( D: Double ): AnsiString; +function Double2Str( D: Double ): KOLString; {* } -function Extended2Str( E: Extended ): AnsiString; +function Extended2Str( E: Extended ): KOLString; {* } -function Extended2StrDigits( D: Double; n: Integer ): AnsiString; +function Extended2StrDigits( D: Double; n: Integer ): KOLString; {* Converts floating point number to string, leaving exactly n digits following floating point. } - function Double2StrEx( D: Double ): AnsiString; {* experimental, do not use } - function TruncD( D: Double ): Double; {* Result := trunc( D ) as Double; |

@@ -10487,7 +11094,6 @@ function IfThenElse( t, e: AnsiString; Cond: Boolean ): AnsiString; overload; function IfThenElse( t, e: Double; Cond: Boolean ): Double; overload; {$ENDIF} -//[SMALL BIT ARRAYS DECLARATIONS] function GetBits( N: DWORD; first, last: Byte ): DWord; {* Retuns bits straing from and to inclusively. } function GetBitsL( N: DWORD; from, len: Byte ): DWord; @@ -10504,47 +11110,6 @@ function MulDiv( A, B, C: Integer ): Integer; {* Returns A * B div C. Small and fast. } {$ENDIF} -//[TMethod TYPE] -type -/////////////////////////////////////////// -{$ifndef _D6orHigher} // -/////////////////////////////////////////// - TMethod = packed record - {* Is defined here because using of VCL classes.pas unit is - not recommended in XCL. This record type is used often - to set/access event handlers, referring to a procedure - of object (usually to set such event to an ordinal - procedure setting Data field to nil. } - Code: Pointer; // Pointer to method code. - {* If used to fake assigning to event handler of type 'procedure - of object' with ordinal procedure pointer, use symbol '@' - before method: - |
       - | Method.Code := @MyProcedure; - | } - Data: Pointer; // Pointer to object, owning the method. - {* To fake event of type 'procedure of object' with setting it to - ordinal procedure assign here NIL; } - end; - {* When assigning TMethod record to event handler, typecast it with - desired event type, e.g.: - |
       - | SomeObject.OnSomeEvent := TOnSomeEvent( Method ); - |
} -/////////////////////////////////////////// -{$endif} // -/////////////////////////////////////////// - PMethod = ^TMethod; - {* } - - function MakeMethod( Data, Code: Pointer ): TMethod; - {* Help function to construct TMethod record. Can be useful to - assign regular type procedure/function as event handler for - event, defined as object method (do not forget, that in that - case it must have first dummy parameter to replace @Self, - passed in EAX to methods of object). } - -//[Rectangles&Points DECLARATIONS] function MakeRect( Left, Top, Right, Bottom: Integer ): TRect; stdcall; {* Use it instead of VCL Rect function } function RectsEqual( const R1, R2: TRect ): Boolean; @@ -10569,13 +11134,10 @@ type {* Use instead of VCL function Point } function MakeSmallPoint( X, Y: Integer ): TSmallPoint; {* Use to construct TSmallPoint } -//[MakeFlags DECLARATION] function MakeFlags( FlgSet: PDWORD; FlgArray: array of Integer): Integer; {* } - - function MakeDateTimeRange( D1, D2: TDateTime ): TDateTimeRange; - {* Returns TDateTimeRange from two TDateTime bounds. } - + function MakeDateTimeRange( D1, D2: TDateTime ): TDateTimeRange; + {* Returns TDateTimeRange from two TDateTime bounds. } //[Integer FUNCTIONS DECLARATIONS] procedure Swap( var X, Y: Integer ); overload; procedure Swap(var X, Y: Byte); overload; @@ -10596,15 +11158,13 @@ type function iCbrt( X: DWORD ): Integer; {* cubic root |
- } -//[Integer<->String DECLARATIONS] -function Int2Hex( Value : DWord; Digits : Integer ) : AnsiString; +function Int2Hex( Value : DWord; Digits : Integer ) : KOLString; {* Converts integer Value into string with hex number. Digits parameter determines minimal number of digits (will be completed by adding necessary number of leading zeroes). } -function Int2Str( Value : Integer ) : AnsiString; +function Int2Str( Value : Integer ) : KOLString; {* Obvious. } procedure Int2PChar( s: PAnsiChar; Value: Integer ); {* Converts Value to string and puts it into buffer s. Buffer must have @@ -10638,7 +11198,7 @@ function Str2Int(const Value : AnsiString) : Integer; {* Converts string to integer. First character, which can not be recognized as a part of number, regards as a separator. Even empty string or string without number silently converted to 0. } -function Hex2Int( const Value : AnsiString) : Integer; +function Hex2Int( const Value : KOLString) : Integer; {* Converts hexadecimal number to integer. Scanning is stopped when first non-hexadicimal character is found. Leading dollar ('$') character is skept (if present). Minus ('-') is not concerning as @@ -10681,7 +11241,6 @@ function Format( const fmt: KOLString; params: array of const ): KOLString; } {$ENDIF _FPC} {$ENDIF WIN} -//[String FUNCTIONS DECLARATIONS] function StrComp(const Str1, Str2: PAnsiChar): Integer; {* Compares two strings fast. -1: Str1Str2 } {$IFDEF SMALLER_CODE} @@ -10750,6 +11309,16 @@ function AnsiUpperCase(const S: Ansistring): Ansistring; {* Obvious. } function AnsiLowerCase(const S: Ansistring): Ansistring; {* Obvious. } +function KOLUpperCase(const S: KOLString): KOLString; +{* Obvious. } +function KOLLowerCase(const S: KOLString): KOLString; +{* Obvious. } +{$IFDEF _D3orHigher} +function WUpperCase(const S: WideString): WideString; +{* Obvious. } +function WLowerCase(const S: WideString): WideString; +{* Obvious. } +{$ENDIF} {$IFNDEF _D2} {$IFNDEF _FPC} function WAnsiUpperCase(const S: WideString): WideString; @@ -10833,6 +11402,10 @@ function IndexOfCharsMin( const S, Chars : KOLString ) : Integer; {* Returns index (in string S) of those character, what is taking place in Chars string and located nearest to start of S. If no such characters in string S found, -1 is returned. } +{$IFDEF _D3orHigher} +function WIndexOfChar( const S : WideString; Chr : WideChar ) : Integer; +function WIndexOfCharsMin( const S, Chars : WideString ) : Integer; +{$ENDIF} {$IFNDEF _D2} {$IFNDEF _FPC} function IndexOfWideCharsMin( const S, Chars : WideString ) : Integer; @@ -10851,6 +11424,10 @@ function Parse( var S : KOLString; const Separators : KOLString ) : KOLString; a tail of string (after found separator) to source string. If no separator characters found, source string S is returned, and source string itself becomes empty. } +{$IFDEF _D3orHigher} +function ParseW( var S : WideString; const Separators : WideString ) : WideString; +{$ENDIF} + {$IFNDEF _FPC} {$IFNDEF _D2} function WParse( var S : WideString; const Separators : WideString ) : WideString; @@ -10977,7 +11554,6 @@ function SkipSpaces( P: PKOLChar ): PKOLChar; function DummyStrFun( const S: AnsiString ): AnsiString; {$ENDIF} -//[Memory FUNCTIONS DECLARATIONS] function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; {* Fast compare of two memory blocks. } function AllocMem( Size : Integer ) : Pointer; @@ -10991,7 +11567,6 @@ procedure DisposeMem( var Addr : Pointer ); } {$IFDEF WIN_GDI} -//[clipboard FUNCTIONS DECLARATIONS] function ClipboardHasText: Boolean; {* Returns true, if the clipboard contain text to paste from. } function Clipboard2Text: AnsiString; @@ -11013,7 +11588,6 @@ function WText2Clipboard( const WS: WideString ): Boolean; {$ENDIF _D2} {$ENDIF _FPC} -//[Mnemonics FUNCTIONS DECLARATIONS] var SearchMnemonics: function ( const S: KOLString ): KOLString = {$IFDEF F_P} DummyStrFun {$ELSE} {$IFDEF UNICODE_CTRLS} WAnsiUpperCase {$ELSE} AnsiUpperCase {$ENDIF} {$ENDIF}; @@ -11028,7 +11602,6 @@ procedure SupportAnsiMnemonics( LocaleID: Integer ); } {$ENDIF WIN_GDI} {$IFDEF WIN_GDI} -//[TDateTime TYPE DEFINITION] type //TDateTime = Double; // well, it is already defined so in System.pas {* Basic date and time type. Integer part represents year and days (as is, @@ -11067,12 +11640,6 @@ const value from VCL date. And to convert back from KOL date to VCL date, add this value to KOL date.} -{++}(* -procedure GetLocalTime(var lpSystemTime: TSystemTime); stdcall; -procedure GetSystemTime(var lpSystemTime: TSystemTime); stdcall; -*){--} - -//[Date&Time FUNCTIONS DECLARATIONS] function Now : TDateTime; {* Returns local date and time on running PC. } function Date: TDateTime; @@ -11186,7 +11753,6 @@ function Str2DateTimeShortEx( const S: KOLString ): TDateTime; } {$ENDIF WIN_GDI} -//[OpenFile CONSTANTS] const ofOpenRead = {$IFDEF LIN} O_RDONLY {$ELSE} $80000000 {$ENDIF}; {* Use this flag (in combination with others) to open file for "read" only. } @@ -11239,9 +11805,7 @@ const only if ofAttrCompressed is not specified also. } ofAttrOffline = {$IFDEF LIN} 0 {$ELSE} $10000000 {$ENDIF}; {* Use this flag to create offline file. } -//[END OF OpenFileConstants] -//[File FUNCTIONS DECLARATIONS] {$IFDEF _D3orHigher} function WFileCreate(const FileName: WideString; OpenFlags: DWord): THandle; {* } @@ -11405,7 +11969,6 @@ function CheckDirectoryContent( const Name: KOLString; SubDirsOnly: Boolean; con satisfying given mask. } function DirectoryEmpty(const Name: KOLString): Boolean; {* Returns True if given directory is not exists or empty. } -//[Directory FUNCTIONS DECLARATIONS] function DirectoryHasSubdirs( const Path: KOLString ): Boolean; {* Returns TRUE if given directory exists and has subdirectories. } function GetStartDir: KOLString; @@ -11520,8 +12083,7 @@ function DeleteFile2Recycle( const Filename : KOLString ) : Boolean; used or not fully qualified paths to files. } function CopyMoveFiles( const FromList, ToList: KOLString; Move: Boolean ): Boolean; {* } -{-} -function DiskFreeSpace( const Path: KOLString ): I64; {+} +function DiskFreeSpace( const Path: KOLString ): I64; {* Returns disk free space in bytes. Pass a path to root directory, e.g. 'C:\'. |
@@ -11533,11 +12095,6 @@ function DiskFreeSpace( const Path: KOLString ): I64; {+} {$ENDIF WIN_GDI} //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ {$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -//[Registry FUNCTIONS DECLARATIONS] -{++}(* -function RegSetValueEx(hKey: HKEY; lpValueName: PAnsiChar; - Reserved: DWORD; dwType: DWORD; lpData: Pointer; cbData: DWORD): Longint; stdcall; -*){--} function RegKeyOpenRead( Key: HKey; const SubKey: KOLString ): HKey; {* Opens registry key for read operations (including enumerating of subkeys). Pass either handle of opened earlier key or one of constans @@ -11553,7 +12110,8 @@ function RegKeyGetStr( Key: HKey; const ValueName: KOLString ): KOLString; not successful, empty string is returned. This function as well as all other registry manipulation functions, does nothing, if Key passed is 0 (without producing any error). } -function RegKeyGetStrEx( Key: HKey; const ValueName: KOLString ): KOLString; +function RegKeyGetStrEx( Key: HKey; const ValueName: KOLString + {$IFDEF OPTIONAL_REG_EXPAND_SZ} ; ExpandEnvVars: Boolean {$ENDIF} ): KOLString; {* Like RegKeyGetStr, but accepts REG_EXPAND_SZ type, expanding all environment variables in resulting string. |
@@ -11578,7 +12136,7 @@ function RegKeyDelete( Key: HKey; const SubKey: KOLString ): Boolean; {* Deletes key. Does nothing if key passed is 0 (returns FALSE). } function RegKeyDeleteValue( Key: HKey; const SubKey: KOLString ): Boolean; {* Deletes value. - by neuron, e-mailto:neuron@hollowtube.mine.nu } -function RegKeyExists( Key: HKey; const SubKey: AnsiString ): Boolean; +function RegKeyExists( Key: HKey; const SubKey: KOLString ): Boolean; {* Returns TRUE, if given subkey exists under given Key. } function RegKeyValExists( Key: HKey; const ValueName: KOLString ): Boolean; {* Returns TRUE, if given value exists under the Key. @@ -11645,7 +12203,7 @@ function RegKeyGetValueTyp (const Key:HKEY; const ValueName: KOLString) : DWORD; renamed to SortData - which is a regular procedure now). } {$ENDIF WIN_GDI} //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -//[SortData FUNCTIONS DECLARATIONS] + procedure SortData( const Data: Pointer; const uNElem: Dword; const CompareFun: TCompareEvent; const SwapProc: TSwapEvent ); @@ -11667,8 +12225,7 @@ procedure SortDwordArray( var A : array of DWORD ); {* Procedure to sort array of unsigned 32-bit integers. |
} -{ -- directory list object -- } -//[DirList Object] +{ ------------------- directory list object ---------------------------------- } type TDirItemAction = ( diSkip, diAccept, diCancel ); @@ -11680,12 +12237,10 @@ type {* List of rules (options) to sort directories. Rules are passed to Sort method in an array, and first placed rules are applied first. } - {++}(*TDirList = class;*){--} - PDirList = {-}^{+}TDirList; + PDirList = ^TDirList; { ---------------------------------------------------------------------- TDirList - Directory scanning ----------------------------------------------------------------------- } -//[TDirList DEFINITION] TDirList = object( TObj ) {* Allows easy directory scanning. This is not visual object, but storage to simplify working with directory content. } @@ -11700,8 +12255,7 @@ type function GetIsDirectory(Idx: Integer): Boolean; protected function SatisfyFilter( FileName : PKOLChar; FileAttr, FindAttr : DWord ) : Boolean; - {++}(*public*){--} - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* Destructor. As usual, call Free method to destroy an object. } public property Items[ Idx : Integer ] : PFindfileData read Get; default; @@ -11742,31 +12296,22 @@ type To use it, first create PDirList object with empty path to scan, then assign OnItem event and call ScanDirectory with correct path. } end; -//[END OF TDirList DEFINITION] -//[NewDirList DECLARATIONS] function NewDirList( const DirPath, Filter: KOLString; Attr: DWORD ): PDirList; {* Creates directory list object using easy one-string filter. If Attr = FILE_ATTRIBUTE_NORMAL, only files are scanned without directories. If Attr = 0, both files and directories are listed. } - function NewDirListEx( const DirPath, Filters: KOLString; Attr: DWORD ): PDirList; {* Creates directory list object using several filters, separated by ';'. Filters starting from '^' consider to be anti-filters, i.e. files, satisfying to those masks, are skept during scanning. } - const DefSortDirRules : array[ 0..3 ] of TSortDirRules = ( sdrFoldersFirst, sdrByName, sdrBySize, sdrByDateCreate ); {* Default rules to sort directory entries. } - -//[DirectorySize DECLARATION] -{-} function DirectorySize( const Path: KOLString ): I64; {* Returns directory size in bytes as large 64 bit integer. } -{+} {$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -//[OpenSaveDialog OPTIONS] type TOpenSaveOption = ( OSCreatePrompt, OSExtensionDiffent, @@ -11790,12 +12335,10 @@ type TOpenSaveOptions = set of TOpenSaveOption; {* Options available for TOpenSaveDialog. } - {++}(*TOpenSaveDialog = class;*){--} - POpenSaveDialog = {-}^{+}TOpenSaveDialog; + POpenSaveDialog = ^TOpenSaveDialog; { ---------------------------------------------------------------------- TOpenSaveDialog ----------------------------------------------------------------------- } -//[TOpenSaveDialog DEFINITION] TOpenSaveDialog = object( TObj ) {* Object to show standard Open/Save dialog. Initially provided for XCL by Carlo Kok. } @@ -11817,7 +12360,7 @@ type // dialogs (if the symbol OpenSaveDialog_Extended is // not added in project options, place bar is always // enabled in Windows 2000 and higher). - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* destructor } Function Execute : Boolean; {* Call it after creating to perform selecting of file by user. } @@ -11864,22 +12407,17 @@ type {* TRUE after Execute, if Read Only check box was checked by the user. Options are not affected anyway. } end; -//[END OF TOpenSaveDialog DEFINITION] -//[Default OpenSaveDialog OPTIONS] const DefOpenSaveDlgOptions: TOpenSaveOptions = [ OSHideReadonly, OSOverwritePrompt, OSFileMustExist, OSPathMustExist ]; -//[NewOpenSaveDialog DECLARATION] function NewOpenSaveDialog( const Title, StrtDir: KOLString; Options: TOpenSaveOptions ): POpenSaveDialog; {* Creates object, which can be used (several times) to open file(s) selecting dialog. } -//[OpenDirectory Object] type - {++}(*TOpenDirDialog = class;*){--} - POpenDirDialog = {-}^{+}TOpenDirDialog; + POpenDirDialog = ^TOpenDirDialog; TOpenDirOption = ( odBrowseForComputer, odBrowseForPrinter, odDontGoBelowDomain, odOnlyFileSystemAncestors, odOnlySystemDirs, odStatusText, @@ -11899,7 +12437,6 @@ type { ---------------------------------------------------------------------- TOpenDirDialog ----------------------------------------------------------------------- } -//[TOpenDirDialog DEFINITION] TOpenDirDialog = object( TObj ) {* Dialog for open directories, uses SHBrowseForFolder. } protected @@ -11920,7 +12457,7 @@ type procedure SetOnSelChanged(const Value: TOnODSelChange); function GetInitialPath: KOLString; public - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* destructor } function Execute : Boolean; {* Call it to select directory by user. Returns True, if operation was @@ -11949,15 +12486,12 @@ type first call of callback procedure (i.e. on the first call to OnSelChanged). } end; -//[END OF TOpenDirDialog DEFINITION] -//[NewOpenSaveDialog DECLARATION] function NewOpenDirDialog( const Title: KOLString; Options: TOpenDirOptions ): POpenDirDialog; {* Creates object, which can be used (several times) to open directory selecting dialog (using SHBrowseForFolder API call). } -//[Color Dialog Object] type TColorCustomOption = ( ccoFullOpen, ccoShortOpen, ccoPreventFullOpen ); @@ -11965,12 +12499,10 @@ type type TKOLOpenDirDialog = POpenDirDialog; {$ENDIF} - {++}(*TColorDialog = class;*){--} - PColorDialog = {-}^{+}TColorDialog; + PColorDialog = ^TColorDialog; { ---------------------------------------------------------------------- TColorDialog ----------------------------------------------------------------------- } -//[TColorDialog DEFINITION] TColorDialog = object( TObj ) {* Color choosing dialog. } protected @@ -11986,27 +12518,22 @@ type TKOLOpenDirDialog = POpenDirDialog; function Execute: Boolean; {* Call this method to open a dialog and wait its result. } end; -//[END OF TColorDialog DEFINITION] -//[NewColorDialog DECLARATION] function NewColorDialog( FullOpen: TColorCustomOption ): PColorDialog; {* Creates color choosing dialog object. } {$ENDIF WIN_GDI} {$IFDEF WIN_GDI} -//[Ini files] type TIniFileMode = ( ifmRead, ifmWrite ); {* ifmRead is default mode (means "read" data from ini-file. Set mode to ifmWrite to write data to ini-file, correspondent to TIniFile. } - {++}(*TIniFile = class;*){--} - PIniFile = {-}^{+}TIniFile; + PIniFile = ^TIniFile; { ---------------------------------------------------------------------- TIniFile - store/load data to ini-files ----------------------------------------------------------------------- } -//[TIniFile DEFINITION] TIniFile = object( TObj ) {* Ini file incapsulation. The main feature is what the same block of read-write operations could be defined (difference must be only in @@ -12033,7 +12560,7 @@ type fSection: KOLString; protected public - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* destructor } property Mode: TIniFileMode read fMode write fMode; {* ifmWrite, if write data to ini-file rather than read it. } @@ -12069,13 +12596,10 @@ type /////////////// end; -//[END OF TIniFile DEFINITION] -//[OpenIniFile DECLARATION] function OpenIniFile( const FileName: KOLString ): PIniFile; {* Opens ini file, creating TIniFile object instance to work with it. } {$ENDIF WIN_GDI} -//[MENU OBJECT] type TMenuitemInfo = packed record @@ -12101,8 +12625,7 @@ const TPM_NOANIMATION = $4000; type - {++}(*TMenu = class;*){--} - PMenu = {-}^{+}TMenu; + PMenu = ^TMenu; TOnMenuItem = procedure( Sender : PMenu; Item : Integer ) of object; {* Event type to define OnMenuItem event. } @@ -12129,7 +12652,6 @@ type { ---------------------------------------------------------------------- TMenu - main, popup menu and menu item ----------------------------------------------------------------------- } -//[TMenu DEFINITION] TMenu = object( TObj ) protected {$IFDEF GDI} @@ -12231,7 +12753,7 @@ type function GetItemSubMenu( Idx: Integer ): HMenu; {$ENDIF GDI} public - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* To release menu dynamically, call Free method instead. All (popup) menus created after this (for the same control) are destroyed in that case too. @@ -12483,17 +13005,14 @@ type {$ENDIF USE_MENU_CURCTL} {$ENDIF GDI} end; -//[END OF TMenu DEFINITION] {$IFDEF WIN_GDI} -//[MenuStructSize VARIABLE] function MenuStructSize: Integer; {* Returns 44 under Windows95, and 48 (=sizeof(TMenuItemInfo) under all other Windows versions. } var FDynamicMenuID: DWORD = $1000; {$ENDIF WIN_GDI} -//[NewMenu DECLARATION] function NewMenu( AParent : PControl; MaxCmdReserve: DWORD; const Template : array of PKOLChar; aOnMenuItem: TOnMenuItem ): PMenu; {* Menu constructor. First created menu becomes main menu of form (if AParent @@ -12536,12 +13055,10 @@ function NewMenuEx( AParent : PControl; FirstCmd : Integer; {* Creates menu, assigning its own event handler for every (enough) menu item. } {$IFDEF WIN_GDI} -//[MakeAccelerator DECLARATION] function MakeAccelerator( fVirt: Byte; Key: Word ): TMenuAccelerator; {* Creates accelerator item to assign it to TMenu.ItemAccelerator[ ] property easy.} -//[GetAcceleratorText DECLARATION] // {YS} added 7 Aug 2004 function GetAcceleratorText( const Accelerator: TMenuAccelerator ): KOLString; {* Returns text representation of accelerator. @@ -12549,7 +13066,6 @@ function GetAcceleratorText( const Accelerator: TMenuAccelerator ): KOLString; } -//[Window FUNCTIONS DECLARATIONS] type TWindowChildKind = ( wcActive, wcFocus, wcCapture, wcMenuOwner, wcMoveSize, wcCaret ); @@ -12639,8 +13155,8 @@ function ExecuteIORedirect( const AppPath, CmdLine, DfltDirectory: KOLString; |
    Notes: if your application is not console and it does not create console using AllocConsole, this function will fail to redirect input-output. } -function ExecuteConsoleAppIORedirect( const AppPath, CmdLine, DfltDirectory: AnsiString; - Show: DWORD; const InStr: AnsiString; var OutStr: AnsiString; WaitTimeout: DWORD ) +function ExecuteConsoleAppIORedirect( const AppPath, CmdLine, DfltDirectory: KOLString; + Show: DWORD; const InStr: KOLString; var OutStr: KOLString; WaitTimeout: DWORD ) : Boolean; {* Executes an application, redirecting its console input and output. After redirecting input and output and launching the application, @@ -12672,7 +13188,6 @@ function WinVer : TWindowsVersion; {* Returns Windows version. } function IsWinVer( Ver : TWindowsVersions ) : Boolean; {* Returns True if Windows version is in given range of values. } -//[Parameters FUNCTIONS DECLARATIONS] function ParamStr( Idx: Integer ): KOLString; {* Returns command-line parameter by index. This function supersides standard ParamStr function. } @@ -12699,15 +13214,12 @@ procedure StartDC; procedure FinishDC; {$ENDIF ASM_VERSION} -//[WndProcXXX OTHER DECLARATIONS] function WndProcCtrl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; function WndProcDoEraseBkgnd( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var CreatingWindow: PControl; //ActiveWindow: HWnd; {$ENDIF WIN_GDI} -//[Assert OPERATOR DECLARATION] -{-} {$IFDEF _D2} // Assert operator was not available in Delphi2. Provide here easy Assert // procedure for Delphi2. @@ -12715,9 +13227,7 @@ procedure Assert( Cond: Boolean; const Msg: AnsiString ); var AssertErrorProc: procedure( const Message, Filename: AnsiString; LineNumber: Integer ); {$ENDIF} -{+} -//[CUSTOM EXTENSIONS] {$IFDEF USE_CUSTOMEXTENSIONS} {$I CUSTOM_KOL_EXTENSION.inc} // See comments in TControl {$ENDIF} @@ -12727,30 +13237,54 @@ var EndSession_Initiated: Boolean; {$ENDIF} {$IFDEF WIN_GDI} -//[FMMNotify VARIABLE] var FMMNotify: procedure( var Msg: TMsg ); -//[procedure ClearText forward declaration] procedure ClearText( Sender: PControl ); -//[procedure ClearListbox forward declaration] procedure ClearListbox( Sender: PControl ); -//[procedure ClearCombobox forward declaration] procedure ClearCombobox( Sender: PControl ); -//[procedure ClearListView forward declaration] procedure ClearListView( Sender: PControl ); -//[procedure ClearTreeView forward declaration] procedure ClearTreeView( TV: PControl ); -//[START OF ACTIONS] +{$IFDEF COMMANDACTIONS_OBJ} +const OTHER_ACTIONS = 0; + LABEL_ACTIONS = 1; + BUTTON_ACTIONS = 2; + EDIT_ACTIONS = 3; + LIST_ACTIONS = 4; + COMBO_ACTIONS = 5; + LISTVIEW_ACTIONS = 6; + TREEVIEW_ACTIONS = 7; + TABCONTROL_ACTIONS = 8; + RICHEDIT_ACTIONS = 9; + PROGRESS_ACTIONS = 10; + TOOLBAR_ACTIONS = 11; + LAST_ACTIONS = 11; +var AllActions_Objs: array[ 0..LAST_ACTIONS ] of PCommandActionsObj; +{$ENDIF} + const + {$IFDEF PACK_COMMANDACTIONS} + ButtonActions_Packed: PAnsiChar = Char(BUTTON_ACTIONS) + + #0#0 + //BN_CLICKED + #6#0 + //BN_SETFOCUS + #7#0 + //BN_KILLFOCUS + #225 + //25 нулей + #0#1 + //BS_LEFT + #0#2 + //BS_RIGHT + #0#3 + //BS_CENTER + #0#12 + //0, BS_VCENTER>>8 + #4#8 + //BS_TOP>>8, BS_BOTTOM>>8 + #203 + //3 нуля + #201; + {$ELSE} ButtonActions: TCommandActions = ( aClear: ClearText; aAddText: nil; aClick: BN_CLICKED; aEnter: BN_SETFOCUS; aLeave: BN_KILLFOCUS; - aChange: 0; //BN_CLICKED; + aChange: 0; aSelChange: 0; aGetCount: 0; aSetCount: 0; @@ -12764,13 +13298,11 @@ const aInsertItem: 0; aFindItem: 0; aFindPartial: 0; - aItem2Pos: 0; - aPos2Item: 0; - //aGetSelStart: 0; + bItem2Pos: 0; + bPos2Item: 0; aGetSelCount: 0; aGetSelected: 0; aGetSelRange: 0; - //aExGetSelRange: 0; aGetCurrent: 0; aSetSelected: 0; aSetCurrent: 0; @@ -12781,19 +13313,28 @@ const aTextAlignLeft: BS_LEFT; aTextAlignRight: BS_RIGHT; aTextAlignCenter: BS_CENTER; - aTextAlignMask: 0; - aVertAlignCenter: BS_VCENTER shr 8; - aVertAlignTop: BS_TOP shr 8; - aVertAlignBottom: BS_BOTTOM shr 8; + bTextAlignMask: 0; + bVertAlignCenter: BS_VCENTER shr 8; + bVertAlignTop: BS_TOP shr 8; + bVertAlignBottom: BS_BOTTOM shr 8; aDir: 0; aSetLimit: 0; aSetImgList: 0; - aAutoSzX: 14; - aAutoSzY: 6; + //-----aAutoSzX: 14; + //-----aAutoSzY: 6; aSetBkColor: 0; ); + {$ENDIF} const + {$IFDEF PACK_COMMANDACTIONS} + LabelActions_Packed: PAnsiChar = Char( LABEL_ACTIONS ) + + #229 + //29 нулей + #2#0 + // SS_RIGHT + #1#0 + // SS_CENTER + #12#2 + // SS_LEFTNOWORDWRAP, SS_CENTERIMAGE>>8 + #205; + {$ELSE} LabelActions: TCommandActions = ( aClear: ClearText; aAddText: nil; @@ -12814,13 +13355,11 @@ const aInsertItem: 0; aFindItem: 0; aFindPartial: 0; - aItem2Pos: 0; - aPos2Item: 0; - //aGetSelStart: 0; + bItem2Pos: 0; + bPos2Item: 0; aGetSelCount: 0; aGetSelected: 0; aGetSelRange: 0; - //aExGetSelRange: 0; aGetCurrent: 0; aSetSelected: 0; aSetCurrent: 0; @@ -12831,20 +13370,51 @@ const aTextAlignLeft: SS_LEFT; aTextAlignRight: SS_RIGHT; aTextAlignCenter: SS_CENTER; - aTextAlignMask: SS_LEFTNOWORDWRAP; - aVertAlignCenter: SS_CENTERIMAGE shr 8; - aVertAlignTop: 0; - aVertAlignBottom: 0; + bTextAlignMask: SS_LEFTNOWORDWRAP; + bVertAlignCenter: SS_CENTERIMAGE shr 8; + bVertAlignTop: 0; + bVertAlignBottom: 0; aDir: 0; aSetLimit: 0; aSetImgList: 0; - aAutoSzX: 1; - aAutoSzY: 1; + //---- aAutoSzX: 1; + //---- aAutoSzY: 1; aSetBkColor: 0; ); + {$ENDIF} const EN_LINK = $070b; + {$IFDEF PACK_COMMANDACTIONS} + EditActions_Packed: PAnsiChar = Char( EDIT_ACTIONS ) + + #201 + + #0#1 + // EN_SETFOCUS + #0#2 + // EN_KILLFOCUS + #0#3 + // EN_CHANGE + #201 + + #$BA#0 + // EM_GETLINECOUNT + #201 + + #$C1#0 + // EM_LINELENGTH + #$C4#0 + // EM_GETLINE + #$C2#0 + // EM_REPLACESEL + #207 + + #$BB#$C9 + // EM_LINEINDEX, EM_LINEFROMCHAR + #$B0#0 + // EM_GETSEL + #201 + + #$B0#0 + // EM_GETSEL + #$BB#0 + // EM_LINEINDEX + #202 + + #$BA#0 + // EM_SETSEL + #202 + + #$C2#0 + // EM_REPLACESEL + #201 + // ES_LEFT + #2#0 + // ES_RIGHT + #1#0 + // ES_CENTER + #203 + + #$C5#0 + // EM_SETLIMITTEXT + #202 + + #200#214#0; // EM_POSFROMCHAR + {$ELSE} EditActions: TCommandActions = ( aClear: ClearText; aAddText: nil; @@ -12865,13 +13435,11 @@ const aInsertItem: 0; aFindItem: 0; aFindPartial: 0; - aItem2Pos: EM_LINEINDEX; - aPos2Item: EM_LINEFROMCHAR; - //aGetSelStart: 0; + bItem2Pos: EM_LINEINDEX; + bPos2Item: EM_LINEFROMCHAR; aGetSelCount: EM_GETSEL; aGetSelected: 0; aGetSelRange: EM_GETSEL; - //aExGetSelRange: 0; aGetCurrent: EM_LINEINDEX; aSetSelected: 0; aSetCurrent: 0; @@ -12882,20 +13450,52 @@ const aTextAlignLeft: ES_LEFT; aTextAlignRight: ES_RIGHT; aTextAlignCenter: ES_CENTER; - aTextAlignMask: 0; - aVertAlignCenter: 0; - aVertAlignTop: 0; - aVertAlignBottom: 0; + bTextAlignMask: 0; + bVertAlignCenter: 0; + bVertAlignTop: 0; + bVertAlignBottom: 0; aDir: 0; aSetLimit: EM_SETLIMITTEXT; aSetImgList: 0; - aAutoSzX: 0; - aAutoSzY: 6; + //---- aAutoSzX: 0; + //---- aAutoSzY: 6; aSetBkColor: 0; aItem2XY: EM_POSFROMCHAR; ); + {$ENDIF} const + {$IFDEF PACK_COMMANDACTIONS} + ListActions_Packed: PAnsiChar = Char(LIST_ACTIONS) + + #2#0 + // LBN_DBLCLK + #4#0 + // LBN_SETFOCUS + #5#0 + // LBN_KILLFOCUS + #201 + + #1#0 + // LBN_SELCHANGE + #$8B#1 + // LB_GETCOUNT + #$A7#1 + // LB_SETCOUNT + #$8A#1 + // LB_GETTEXTLEN + #$89#1 + // LB_GETTEXT + #201 + + #$99#1 + // LB_GETITEMDATA + #$9A#1 + // LB_SETITEMDATA + #$80#1 + // LB_ADDSTRING + #$82#1 + // LB_DELETESTRING + #$81#1 + // LB_INSERTSTRING + #$A2#1 + // LB_FINDSTRINGEXACT + #$8F#1 + // LB_FINDSTRING + #201 + + #$90#1 + // LB_GETSELCOUNT + #$87#1 + // LB_GETSEL + #201 + + #$88#1 + // LB_GETCURSEL + #$85#1 + // LB_SETSEL + #$86#1 + // LB_SETCURSEL + #209 + + #$8D#1 + // LB_DIR + #203 + + #$98#1; // LB_GETITEMRECT + {$ELSE} ListActions: TCommandActions = ( aClear: ClearListbox; aAddText: nil; @@ -12916,13 +13516,11 @@ const aInsertItem: LB_INSERTSTRING; aFindItem: LB_FINDSTRINGEXACT; aFindPartial: LB_FINDSTRING; - aItem2Pos: 0; - aPos2Item: 0; - //aGetSelStart: 0; + bItem2Pos: 0; + bPos2Item: 0; aGetSelCount: LB_GETSELCOUNT; aGetSelected: LB_GETSEL; aGetSelRange: 0; - //aExGetSelRange: 0; aGetCurrent: LB_GETCURSEL; aSetSelected: LB_SETSEL; aSetCurrent: LB_SETCURSEL; @@ -12933,20 +13531,50 @@ const aTextAlignLeft: 0; aTextAlignRight: 0; aTextAlignCenter: 0; - aTextAlignMask: 0; - aVertAlignCenter: 0; - aVertAlignTop: 0; - aVertAlignBottom: 0; + bTextAlignMask: 0; + bVertAlignCenter: 0; + bVertAlignTop: 0; + bVertAlignBottom: 0; aDir: LB_DIR; aSetLimit: 0; aSetImgList: 0; - aAutoSzX: 0; - aAutoSzY: 0; + //---- aAutoSzX: 0; + //---- aAutoSzY: 0; aSetBkColor: 0; aItem2XY: LB_GETITEMRECT; ); + {$ENDIF} const + {$IFDEF PACK_COMMANDACTIONS} + ComboActions_Packed: PAnsiChar = Char(COMBO_ACTIONS) + + #2#0 + // CBN_DBLCLK + #3#0 + // CBN_SETFOCUS + #4#0 + // CBN_KILLFOCUS + #5#0 + // CBN_EDITCHANGE + #15#0 + // CM_CBN_SELCHANGE + #$46#1 + // CB_GETCOUNT + #201 + + #$49#1 + // CB_GETLBTEXTLEN + #$48#1 + // CB_GETLBTEXT + #201 + + #$50#1 + // CB_GETITEMDATA + #$51#1 + // CB_SETITEMDATA + #$43#1 + // CB_ADDSTRING + #$44#1 + // CB_DELETESTRING + #$4A#1 + // CB_INSERTSTRING + #$58#1 + // CB_FINDSTRINGEXACT + #$4C#1 + // CB_FINDSTRING + #202 + + #$47#1 + // CB_GETCURSEL + #201 + + #$47#1 + // CB_GETCURSEL + #201 + + #$4E#1 + // CB_SETCURSEL + #209 + + #$45#1 + // CB_DIR + #203; + {$ELSE} ComboActions: TCommandActions = ( aClear: ClearCombobox; aAddText: nil; @@ -12954,7 +13582,7 @@ const aEnter: CBN_SETFOCUS; aLeave: CBN_KILLFOCUS; aChange: CBN_EDITCHANGE; - aSelChange: CM_CBN_SELCHANGE; // CBN_SELCHANGE; + aSelChange: CM_CBN_SELCHANGE; aGetCount: CB_GETCOUNT; aSetCount: 0; aGetItemLength: CB_GETLBTEXTLEN; @@ -12967,13 +13595,11 @@ const aInsertItem: CB_INSERTSTRING; aFindItem: CB_FINDSTRINGEXACT; aFindPartial: CB_FINDSTRING; - aItem2Pos: 0; - aPos2Item: 0; - //aGetSelStart: 0; + bItem2Pos: 0; + bPos2Item: 0; aGetSelCount: 0; aGetSelected: CB_GETCURSEL; aGetSelRange: 0; - //aExGetSelRange: 0; aGetCurrent: CB_GETCURSEL; aSetSelected: 0; aSetCurrent: CB_SETCURSEL; @@ -12984,19 +13610,37 @@ const aTextAlignLeft: 0; //ES_LEFT; aTextAlignRight: 0; //ES_RIGHT; aTextAlignCenter: 0; //ES_CENTER; - aTextAlignMask: 0; - aVertAlignCenter: 0; - aVertAlignTop: 0; - aVertAlignBottom: 0; + bTextAlignMask: 0; + bVertAlignCenter: 0; + bVertAlignTop: 0; + bVertAlignBottom: 0; aDir: CB_DIR; aSetLimit: 0; aSetImgList: 0; - aAutoSzX: 0; - aAutoSzY: 6; + //---- aAutoSzX: 0; + //---- aAutoSzY: 6; aSetBkColor: 0; ); + {$ENDIF} const + {$IFDEF PACK_COMMANDACTIONS} + ListViewActions_Packed: PAnsiChar = Char( LISTVIEW_ACTIONS ) + + #203 + + #$9B#$FF + // LVN_ITEMCHANGED + #201 + + #4#$10 + // LVM_GETITEMCOUNT + #47#$10 + // LVM_SETITEMCOUNT + #211 + + #50#$10 + // LVM_GETSELECTEDCOUNT + #44#$10 + // LVM_GETITEMSTATE + #201 + + #12#$10 + // LVM_GENEXTITEM + #213 + + #3#$10 + // LVM_SETIMAGELIST + #1#$10 + // LVM_SETBKCOLOR + #14#$10; // LVM_GETITEMRECT + {$ELSE} ListViewActions: TCommandActions = ( aClear: ClearListView; aAddText: nil; @@ -13017,13 +13661,11 @@ const aInsertItem: 0; aFindItem: 0; aFindPartial: 0; - aItem2Pos: 0; - aPos2Item: 0; - //aGetSelStart: LVM_GETSELECTIONMARK; + bItem2Pos: 0; + bPos2Item: 0; aGetSelCount: { $8000 or} LVM_GETSELECTEDCOUNT; aGetSelected: LVM_GETITEMSTATE; aGetSelRange: 0; - //aExGetSelRange: 0; aGetCurrent: LVM_GETNEXTITEM; aSetSelected: 0; aSetCurrent: 0; @@ -13034,20 +13676,32 @@ const aTextAlignLeft: 0; aTextAlignRight: 0; aTextAlignCenter: 0; - aTextAlignMask: 0; - aVertAlignCenter: 0; - aVertAlignTop: 0; - aVertAlignBottom: 0; + bTextAlignMask: 0; + bVertAlignCenter: 0; + bVertAlignTop: 0; + bVertAlignBottom: 0; aDir: 0; aSetLimit: 0; aSetImgList: LVM_SETIMAGELIST; - aAutoSzX: 0; - aAutoSzY: 0; + //---- aAutoSzX: 0; + //---- aAutoSzY: 0; aSetBkColor: LVM_SETBKCOLOR; aItem2XY: LVM_GETITEMRECT; ); + {$ENDIF} const + {$IFDEF PACK_COMMANDACTIONS} + TreeViewActions_Packed: PAnsiChar = Char( TREEVIEW_ACTIONS ) + + #203 + + {$IFDEF UNICODE_CTRLS} #$34#$FE {$ELSE} #$65#$FE {$ENDIF} + // TVN_ENDLABELEDIT(W) + {$IFDEF UNICODE_CTRLS} #$3E#$FE {$ELSE} #$6E#$FE {$ENDIF} + // TVN_SELCHANGED(W) + #5#$11 + // TVM_GETCOUNT + #229 + + #9#$11 + // TVM_SETIMAGELIST + #29#$11 + // TVM_SETBKCOLOR + #4#$11; // TVM_GETITEMRECT + {$ELSE} TreeViewActions: TCommandActions = ( aClear: ClearTreeView; aAddText: nil; @@ -13068,13 +13722,11 @@ const aInsertItem: 0; aFindItem: 0; aFindPartial: 0; - aItem2Pos: 0; - aPos2Item: 0; - //aGetSelStart: 0; + bItem2Pos: 0; + bPos2Item: 0; aGetSelCount: 0; aGetSelected: 0; aGetSelRange: 0; - //aExGetSelRange: 0; aGetCurrent: 0; aSetSelected: 0; aSetCurrent: 0; @@ -13085,20 +13737,35 @@ const aTextAlignLeft: 0; aTextAlignRight: 0; aTextAlignCenter: 0; - aTextAlignMask: 0; - aVertAlignCenter: 0; - aVertAlignTop: 0; - aVertAlignBottom: 0; - aDir: CB_DIR; + bTextAlignMask: 0; + bVertAlignCenter: 0; + bVertAlignTop: 0; + bVertAlignBottom: 0; + aDir: 0; //CB_DIR; aSetLimit: 0; aSetImgList: TVM_SETIMAGELIST; - aAutoSzX: 0; - aAutoSzY: 0; + //---- aAutoSzX: 0; + //---- aAutoSzY: 0; aSetBkColor: TVM_SETBKCOLOR; aItem2XY: TVM_GETITEMRECT; ); + {$ENDIF} const + {$IFDEF PACK_COMMANDACTIONS} + TabControlActions_Packed: PAnsiChar = Char( TABCONTROL_ACTIONS ) + + #203 + + #200#$D9#$FD + // TCN_SELCHANGE + #200#$D9#$FD + // TCN_SELCHANGE + #4#$13 + // TCM_GETITEMCOUNT + #215 + + #11#$13 + // TCM_GETCURSEL + #201 + + #12#$13 + // TCM_SETCURSEL + #211 + + #3#$13 + // TCM_SETIMAGELIST + #10#$13; // TCM_GETITEMRECT + {$ELSE} TabControlActions: TCommandActions = ( aClear: ClearText; aAddText: nil; @@ -13119,13 +13786,11 @@ const aInsertItem: 0; aFindItem: 0; aFindPartial: 0; - aItem2Pos: 0; - aPos2Item: 0; - //aGetSelStart: 0; + bItem2Pos: 0; + bPos2Item: 0; aGetSelCount: 0; aGetSelected: 0; aGetSelRange: 0; - //aExGetSelRange: 0; aGetCurrent: TCM_GETCURSEL; aSetSelected: 0; aSetCurrent: TCM_SETCURSEL; //TCM_SETCURFOCUS; @@ -13136,21 +13801,53 @@ const aTextAlignLeft: 0; aTextAlignRight: 0; aTextAlignCenter: 0; - aTextAlignMask: 0; - aVertAlignCenter: 0; - aVertAlignTop: 0; - aVertAlignBottom: 0; - aDir: CB_DIR; + bTextAlignMask: 0; + bVertAlignCenter: 0; + bVertAlignTop: 0; + bVertAlignBottom: 0; + aDir: 0; // CB_DIR; aSetLimit: 0; aSetImgList: TCM_SETIMAGELIST; - aAutoSzX: 0; - aAutoSzY: 0; + //---- aAutoSzX: 0; + //---- aAutoSzY: 0; aSetBkColor: 0; aItem2XY: TCM_GETITEMRECT; ); + {$ENDIF} {$IFNDEF NOT_USE_RICHEDIT} const + {$IFDEF PACK_COMMANDACTIONS} + RichEditActions_Packed: PAnsiChar = Char( RICHEDIT_ACTIONS ) + + #201 + + #0#1 + // EN_SETFOCUS + #0#2 + // EN_KILLFOCUS + #0#3 + // EN_CHANGE + #2#7 + // EN_SELCHANGE + #$BA#0 + // EM_GETLINECOUNT + #201 + + #$C1#0 + // EM_LINELENGTH + #$C4#0 + // EM_GETLINE + #$C2#0 + // EM_REPLACESEL + #207 + + #$BB#$C9 + // EM_LINEINDEX, EM_LINEFROMCHAR + #$B0#0 + // EM_GETSEL + #201 + + #$B0#0 + // EM_GETSEL + #$BB#0 + // EM_LINEINDEX + #203 + + #55#4 + // EM_EXSETSEL + #62#4 + // EM_GETSELTEXT + #$C2#0 + // EM_REPLACESEL + #201 + // ES_LEFT + #2#0 + // ES_RIGHT + #1#0 + // ES_CENTER + #203 + + #53#4 + // EM_EXLIMITTEXT + #201 + + #67#4 + // EM_SETBKGNDCOLOR + #200#214#0; // EM_POSFROMCHAR + {$ELSE} RichEditActions: TCommandActions = ( aClear: ClearText; aAddText: nil; @@ -13171,13 +13868,11 @@ const aInsertItem: 0; aFindItem: 0; aFindPartial: 0; - aItem2Pos: EM_LINEINDEX; - aPos2Item: EM_LINEFROMCHAR; - //aGetSelStart: 0; + bItem2Pos: EM_LINEINDEX; + bPos2Item: EM_LINEFROMCHAR; aGetSelCount: EM_GETSEL; aGetSelected: 0; aGetSelRange: EM_GETSEL; - //aExGetSelRange: EM_EXGETSEL; aGetCurrent: EM_LINEINDEX; aSetSelected: 0; aSetCurrent: 0; @@ -13188,18 +13883,20 @@ const aTextAlignLeft: ES_LEFT; aTextAlignRight: ES_RIGHT; aTextAlignCenter: ES_CENTER; - aTextAlignMask: 0; - aVertAlignCenter: 0; - aVertAlignTop: 0; - aVertAlignBottom: 0; + bTextAlignMask: 0; + bVertAlignCenter: 0; + bVertAlignTop: 0; + bVertAlignBottom: 0; aDir: 0; aSetLimit: EM_EXLIMITTEXT; aSetImgList: 0; - aAutoSzX: 0; - aAutoSzY: 0; + //---- aAutoSzX: 0; + //---- aAutoSzY: 0; aSetBkColor: EM_SETBKGNDCOLOR; aItem2XY: EM_POSFROMCHAR; ); + {$ENDIF} + {$ENDIF NOT_USE_RICHEDIT} const @@ -13310,6 +14007,10 @@ type teEditCaret ); +type TOverrideScrollbarsProc = procedure(Sender: PControl); +procedure DummyOverrideScrollbars(Sender: PControl); +var OverrideScrollbars: TOverrideScrollbarsProc = DummyOverrideScrollbars; + function CrackStack_MapInResource( const MapName: KOLString; Max_length: Integer; HandleSuspiciousAddresses: Boolean ): KOLString; {* Allows to list all procedures and functions called before current cracking @@ -13331,18 +14032,24 @@ function CrackStack_MapInFile( const MapFileName: KOLString; Max_length: Integer {$IFDEF _D2006orHigher} {$I MCKfakeClasses200x.inc} // Dufa {$ENDIF} -//[IMPLEMENTATION] implementation -//[USES-2] -{uses + {$UNDEF CALL_INHERITED} +{$IFDEF _D2orD3} + {$DEFINE CALL_INHERITED} +{$ENDIF} +{$IFnDEF NIL_EVENTS} + {$DEFINE CALL_INHERITED} +{$ENDIF} + +{ -- don't remove this comment!!! + uses //ShellAPI, //commdlg // removing reference to commdlg decreases executable about 0.5 K ; //, commctrl; // in Delphi3, including of commctrl.pas increases executable // onto about 30K. So, all needed definitions are copied here // (see commctrl.inc).} -//[END OF USES-2] {$IFDEF _X_} {$undef uses_2} @@ -13695,7 +14402,6 @@ function ChooseColor(var CC: TChooseColor): Bool; stdcall; external 'comdlg32.dll' name 'ChooseColorA'; {$IFDEF GDI} -//[procedure Chk_BitBlt_ShowError] procedure Chk_BitBlt_ShowError; var Rslt: Integer; begin @@ -13703,9 +14409,7 @@ begin ShowMessage( 'BitBlt ERROR: ' + Int2Str( Rslt ) + ' ' + SysErrorMessage( Rslt ) ); end; -//[END Chk_BitBlt_ShowError] -//[procedure Chk_BitBlt] procedure Chk_BitBlt; var Rslt: Integer; begin @@ -13720,31 +14424,24 @@ begin end; end; end; -//[END Chk_BitBlt] {$ENDIF GDI} -{-} {$ifdef _D2} - -//[PROCEDURE Assert] procedure Assert( Cond: Boolean; const Msg: AnsiString ); begin if not Cond then begin AssertErrorProc( Msg, '', 0 ); - //MsgOK( Msg ); asm int 3; end; end; end; -//[API CreateDIBSection] function CreateDIBSection(DC: HDC; const p2: TBitmapInfo; p3: UINT; var p4: Pointer; p5: THandle; p6: DWORD): HBITMAP; stdcall; external gdi32 name 'CreateDIBSection'; -//[PROCEDURE _LStrFromPCharLen] procedure _LStrFromPCharLen(var Dest: AnsiString; Source: PAnsiChar; Length: Integer); asm { -> EAX pointer to dest } @@ -13786,7 +14483,6 @@ asm POP EBX end; {$endif} -{+} {$IFDEF _D2009orHigher} procedure _aLStrFromPCharLen(var Dest: AnsiString; Source: PAnsiChar; Length: Integer); @@ -13804,7 +14500,6 @@ asm end; {$ENDIF} -//[API InitCommonControls] procedure InitCommonControls; external cctrl name 'InitCommonControls'; type @@ -13815,7 +14510,36 @@ type PInitCommonControlsEx = ^TInitCommonControlsEx; var ComCtl32_Module: HModule; -//[procedure DoInitCommonControls] +{$IFDEF ASM_UNICODE} +const comctl32_const: PKOLChar = 'comctl32'; + InitCommonControlsEx_const: PKOLChar = 'InitCommonControlsEx'; +procedure DoInitCommonControls( dwICC: DWORD ); +asm + PUSH EAX // dwICC + CALL InitCommonControls + MOV EAX, [ComCtl32_Module] + TEST EAX, EAX + JNZ @@1 + PUSH [comctl32_const] + CALL LoadLibrary + MOV [ComCtl32_Module], EAX +@@1:PUSH [InitCommonControlsEx_const] + PUSH EAX + CALL GetProcAddress + XCHG ECX, EAX + {$IFDEF SAFE_CODE} + POP EDX + JECXZ @@fin + PUSH EDX + {$ENDIF} + PUSH 8 // dwSize + PUSH ESP // @ ICC + CALL ECX // Proc( @ ICC ) + POP ECX + POP ECX +@@fin: +end; +{$ELSE PASCAL} procedure DoInitCommonControls( dwICC: DWORD ); var Proc: procedure( ICC: PInitCommonControlsEx ); stdcall; ICC: TInitCommonControlsEx; @@ -13824,23 +14548,23 @@ begin if ComCtl32_Module = 0 then ComCtl32_Module := LoadLibrary( 'comctl32' ); @ Proc := GetProcAddress( ComCtl32_Module, 'InitCommonControlsEx' ); - if Assigned( Proc ) then + {$IFDEF SAFE_CODE} // DoInitCommonControls should work usually. If not, the System is + if Assigned( Proc ) then // not in normal state, and should be repaired anyway. + {$ENDIF} begin ICC.dwSize := Sizeof( ICC ); ICC.dwICC := dwICC; Proc( @ ICC ); end; end; -//[END DoInitCommonControls] +{$ENDIF} const size_TRect = 16; // used often in assembler versions of code -{-} -//22{$IFDEF ASM_VERSION} +{$IFDEF ASM_VERSION} const EmptyString: AnsiString = ''; -//[PROCEDURE EAX2PChar] procedure EAX2PChar; asm TEST EAX, EAX @@ -13849,7 +14573,6 @@ asm @@exit: end; -//[PROCEDURE EDX2PChar] procedure EDX2PChar; asm TEST EDX, EDX @@ -13858,7 +14581,6 @@ asm @@exit: end; -//[PROCEDURE ECX2PChar] procedure ECX2PChar; asm JECXZ @@convert @@ -13868,7 +14590,6 @@ asm @@exit: end; -//[PROCEDURE RemoveStr] procedure RemoveStr; asm { <- [ESP+4] = string to remove @@ -13884,7 +14605,6 @@ asm end; {$IFDEF _D3orHigher} -//[PROCEDURE RemoveWStr] procedure RemoveWStr; asm { <- [ESP+4] = string to remove @@ -13895,12 +14615,11 @@ asm XCHG EAX, [ESP] PUSH EAX MOV EAX, ESP - CALL System.@WStrClr + CALL System.@WStrClr POP EAX end; {$ENDIF _D3orHigher} -//22{$ENDIF ASM_VERSION} -{+} +{$ENDIF ASM_VERSION} const PossibleColorBits : array[1..7] of Byte = ( 1, 4, 8, 16, 24, 32, 0 ); @@ -13941,7 +14660,6 @@ 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; @@ -14292,47 +15010,50 @@ end; {$ENDIF SNAPMOUSE2DFLTBTN} {$IFDEF GDI} -//[function MsgBox] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function MsgBox( const S: KOLString; Flags: DWORD ): DWORD; var Title: PKOLChar; begin - Title := nil; + {$IFDEF SAFE_CODE} // MsgBox should be called when Applet already created + Title := nil; // (and yet not destroyed) if assigned( Applet ) then + {$ENDIF} begin Title := PKOLChar( Applet.fCaption ); end; {$IFDEF SNAPMOUSE2DFLTBTN} - if Assigned( Applet ) then - begin - Applet.AttachProc( WndProcSnapMouse2DfltBtn ); - Applet.Postmsg( 0, 0, 0 ); - end; + {$IFDEF SAFE_CODE} + if Assigned( Applet ) then + {$ENDIF} + begin + Applet.AttachProc( WndProcSnapMouse2DfltBtn ); + Applet.Postmsg( 0, 0, 0 ); + end; {$ENDIF} Result := MessageBox( 0, PKOLChar( S ), Title, Flags ); {$IFDEF SNAPMOUSE2DFLTBTN} - if Assigned( Applet ) then - Applet.DetachProc( WndProcSnapMouse2DfltBtn ); + {$IFDEF SAFE_CODE} + if Assigned( Applet ) then + {$ENDIF} + Applet.DetachProc( WndProcSnapMouse2DfltBtn ); {$ENDIF} end; -//[END MsgBox] {$ENDIF ASM_VERSION} -//[PROCEDURE MsgOK] procedure MsgOK( const S: KOLString ); begin MsgBox( S, MB_OK ); end; -//[function ShowMsg] {$IFDEF ASM_UNICODE} function ShowMsg( const S: KOLString; Flags: DWORD ): DWORD; asm push edx // Flags mov ecx, [Applet] {$IFDEF SNAPMOUSE2DFLTBTN} + {$IFDEF SAFE_CODE} jecxz @@0 + {$ENDIF} pushad xchg eax, ecx mov edx, offset[WndProcSnapMouse2DfltBtn] @@ -14341,7 +15062,9 @@ asm @@0: {$ENDIF} mov edx, 0 + {$IFDEF SAFE_CODE} jecxz @@1 + {$ENDIF} mov edx, [ecx].TControl.fHandle mov ecx, [ecx].TControl.fCaption @@1: push ecx // Title @@ -14350,7 +15073,9 @@ asm call MessageBox {$IFDEF SNAPMOUSE2DFLTBTN} mov ecx, [Applet] + {$IFDEF SAFE_CODE} jecxz @@2 + {$ENDIF} pushad xchg eax, ecx mov edx, offset[WndProcSnapMouse2DfltBtn] @@ -14365,12 +15090,16 @@ var Title: PKOLChar; Wnd: HWnd; begin {$IFDEF SNAPMOUSE2DFLTBTN} - if Assigned( Applet ) then - Applet.AttachProc( WndProcSnapMouse2DfltBtn ); + {$IFDEF SAFE_CODE} + if Assigned( Applet ) then + {$ENDIF} + Applet.AttachProc( WndProcSnapMouse2DfltBtn ); {$ENDIF} + {$IFDEF SAFE_CODE} Title := nil; Wnd := 0; if assigned( Applet ) then + {$ENDIF} begin Title := PKOLChar( Applet.fCaption ); //{$IFNDEF SNAPMOUSE2DFLTBTN} @@ -14379,23 +15108,21 @@ begin end; Result := MessageBox( Wnd, PKOLChar( S ), Title, Flags ); {$IFDEF SNAPMOUSE2DFLTBTN} - if Assigned( Applet ) then - Applet.DetachProc( WndProcSnapMouse2DfltBtn ); + {$IFDEF SAFE_CODE} + if Assigned( Applet ) then + {$ENDIF} + Applet.DetachProc( WndProcSnapMouse2DfltBtn ); {$ENDIF} end; {$ENDIF ASM_VERSION} -//[END ShowMsg] -//[procedure ShowMessage] procedure ShowMessage( const S: KOLString ); begin ShowMsg( S, MB_OK or MB_SETFOREGROUND or MB_DEFBUTTON1 ); end; -//[END ShowMessage] {$ENDIF GDI} {$IFDEF WIN_GDI} -//[procedure SpeakerBeep] procedure SpeakerBeep( Freq: Word; Duration: DWORD ); begin if WinVer >= wvNT then @@ -14425,15 +15152,8 @@ begin end {$IFDEF F_P} [ 'EAX' ] {$ENDIF} ; end; end; -//[END SpeakerBeep] {$ENDIF WIN_GDI} -{++}(* -//[API FormatMessage] -function FormatMessage; external kernel32 name 'FormatMessageA'; -*){--} - -//[FUNCTION SysErrorMessage] function SysErrorMessage(ErrorCode: Integer): KOLString; var Len: Integer; @@ -14445,10 +15165,8 @@ begin while (Len > 0) and ((Buffer[Len - 1] >= #0) and (Buffer[Len - 1] <= ' ')) do Dec(Len); SetString(Result, Buffer, Len); end; -//[END SysErrorMessage] {$ENDIF WIN_GDI} -//[function GetShiftState] function GetShiftState: DWORD; {$IFDEF WIN} const Buttons: array[0..6] of Byte = ( VK_SHIFT, VK_CONTROL, VK_MENU, VK_LBUTTON, @@ -14469,19 +15187,14 @@ begin end; {$ENDIF WIN} end; -//[END GetShiftState] -//[function MakeMethod] function MakeMethod( Data, Code: Pointer ): TMethod; begin Result.Data := Data; Result.Code := Code; end; -//[END MakeMethod] -//[FUNCTION MakeRect] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function MakeRect( Left, Top, Right, Bottom: Integer ): TRect; stdcall; begin Result.Left := Left; @@ -14490,19 +15203,14 @@ begin Result.Bottom := Bottom; end; {$ENDIF ASM_VERSION} -//[END MakeRect] -//[FUNCTION RectsEqual] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function RectsEqual( const R1, R2: TRect ): Boolean; begin Result := CompareMem( @R1, @R2, Sizeof( TRect ) ); end; {$ENDIF ASM_VERSION} -//[END RectsEqual] -//[function RectsIntersected] function RectsIntersected( const R1, R2: TRect ): Boolean; begin Result := ((R1.Left <= R2.Left) and (R1.Right > R2.Left ) or @@ -14513,49 +15221,23 @@ begin (R1.Top <= R2.Bottom) and (R1.Bottom >= R2.Bottom) or (R1.Top >= R2.Top) and (R1.Bottom <= R2.Bottom)) ; end; -//[END RectsIntersected] -//[FUNCTION PointInRect] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function PointInRect( const P: TPoint; const R: TRect ): Boolean; begin Result := (P.x >= R.Left) and (P.x < R.Right) and (P.y >= R.Top) and (P.y < R.Bottom); end; {$ENDIF ASM_VERSION} -//[END PointInRect] -//[FUNCTION OffsetPoint] -{$IFDEF ASM_VERSION} -function OffsetPoint( const T: TPoint; dX, dY: Integer ): TPoint; -asm - ADD EDX, [EAX].TPoint.X - ADD ECX, [EAX].TPoint.Y - MOV EAX, [Result] - MOV [EAX].TPoint.X, EDX - MOV [EAX].TPoint.Y, ECX -end; -{$ELSE ASM_VERSION} // Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} // Pascal function OffsetPoint( const T: TPoint; dX, dY: Integer ): TPoint; begin Result := MakePoint( T.X + dX, T.Y + dY ); end; {$ENDIF ASM_VERSION} -//[FUNCTION OffsetSmallPoint] -{$IFDEF ASM_VERSION} -function OffsetSmallPoint( const T: TSmallPoint; dX, dY: SmallInt ): TSmallPoint; -asm - SHL EDX, 16 - SHLD ECX, EDX, 16 - CALL @@1 -@@1: - ROL EAX, 16 - ROL ECX, 16 - ADD AX, CX -end; -{$ELSE ASM_VERSION} // Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} // Pascal function OffsetSmallPoint( const T: TSmallPoint; dX, dY: SmallInt ): TSmallPoint; begin Result.x := T.x + dX; @@ -14563,14 +15245,7 @@ begin end; {$ENDIF ASM_VERSION} -{$IFDEF ASM_VERSION} -function Point2SmallPoint( const T: TPoint ): TSmallPoint; -asm - XCHG EDX, EAX - MOV EAX, [EDX].TPoint.Y-2 - MOV AX, word ptr [EDX].TPoint.X -end; -{$ELSE ASM_VERSION} // Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} // Pascal function Point2SmallPoint( const T: TPoint ): TSmallPoint; begin Result.x := T.X; @@ -14578,39 +15253,22 @@ begin end; {$ENDIF ASM_VERSION} -{$IFDEF ASM_VERSION} -function SmallPoint2Point( const T: TSmallPoint ): TPoint; -asm - MOVSX ECX, AX - MOV [EDX].TPoint.X, ECX - SAR EAX, 16 - MOV [EDX].TPoint.Y, EAX -end; -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function SmallPoint2Point( const T: TSmallPoint ): TPoint; begin Result := MakePoint( T.x, T.y ); end; {$ENDIF ASM_VERSION} -//[FUNCTION MakePoint] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function MakePoint( X, Y: Integer ): TPoint; begin Result.x := X; Result.y := Y; end; {$ENDIF ASM_VERSION} -//[END MakePoint] -{$IFDEF ASM_VERSION} -function MakeSmallPoint( X, Y: Integer ): TSmallPoint; -asm - SHL EAX, 16 - SHRD EAX, EDX, 16 -end; -{$ELSE ASM_VERSION} // Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} // Pascal function MakeSmallPoint( X, Y: Integer ): TSmallPoint; begin Result.x := X; @@ -14618,9 +15276,7 @@ begin end; {$ENDIF ASM_VERSION} -//[FUNCTION MakeFlags] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function MakeFlags( FlgSet: PDWORD; FlgArray: array of Integer): Integer; var I : Integer; Mask : DWORD; @@ -14638,7 +15294,6 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END MakeFlags] function MakeDateTimeRange( D1, D2: TDateTime ): TDateTimeRange; begin @@ -14646,7 +15301,6 @@ begin Result.ToDate := D2; end; -//[procedure Swap] procedure Swap( var X, Y: Integer ); overload; {$IFDEF F_P} var Tmp: Integer; @@ -14661,10 +15315,8 @@ asm XCHG ECX, [EAX] MOV [EDX], ECX end; -//[END Swap] {$ENDIF F_P/DELPHI} -//[procedure Swap] procedure Swap(var X, Y: Byte); overload; var T: Byte; @@ -14683,7 +15335,6 @@ begin Y := T; end; -//[function Min] function Min( X, Y: Integer ): Integer; asm {$IFDEF F_P} @@ -14700,9 +15351,7 @@ asm @@exit: {$ENDIF} end {$IFDEF F_P} [ 'EAX', 'EDX' ] {$ENDIF}; -//[END Min] -//[function Max] function Max( X, Y: Integer ): Integer; asm {$IFDEF F_P} @@ -14719,10 +15368,8 @@ asm @@exit: {$ENDIF} end {$IFDEF F_P} [ 'EAX', 'EDX' ] {$ENDIF}; -//[END Max] {$IFDEF REDEFINE_ABS} -//[function Abs] function Abs( X: Integer ): Integer; asm {$IFDEF F_P} @@ -14732,10 +15379,8 @@ asm xor eax, edx sub eax, edx end {$IFDEF F_P} [ 'EAX' ] {$ENDIF}; -//[END Abs] {$ENDIF} -//[function Sgn] function Sgn( X: Integer ): Integer; asm CMP EAX, 0 @@ -14752,9 +15397,7 @@ asm @@exit: {$ENDIF} end; -//[END Sgn] -//[function iSqrt] function iSQRT( X: Integer ): Integer; {$IFDEF _D4orHigher} // new version is more efficient but code is not compatible with older compilers @@ -14803,7 +15446,6 @@ begin Result := y; end; {$ENDIF} -//[END iSqrt] function iCbrt( X: DWORD ): Integer; var s: Integer; @@ -14827,7 +15469,6 @@ end; {$IFDEF WIN_GDI} {$IFDEF ASM_DC} -//[PROCEDURE StartDC] procedure StartDC; asm { <- EBX : PBitmap @@ -14852,9 +15493,7 @@ asm PUSH EDX MOV EAX, [ESP+8] end; -//[END StartDC] -//[procedure FinishDC] procedure FinishDC; asm POP ECX @@ -14867,35 +15506,150 @@ asm CALL SelectObject CALL DeleteDC end; -//[END FinishDC] {$ENDIF ASM_DC} -//[function EnumDynHandlers FORWARD DECLARATION] function EnumDynHandlers( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward; {$ENDIF WIN_GDI} -//[procedure DummyObjProc] + procedure DummyObjProc( Sender: PObj ); -begin +begin // 1-2-3 parameters, no result end; -//[procedure DummyObjProcParam] -procedure DummyObjProcParam( Sender: PObj; Param: Pointer ); -begin +function DummyProc123_TRUE( Dummy: Pointer; Sender: PControl; param3: Integer ): Boolean; +begin Result := TRUE; // 1-2-3 params, Result = TRUE end; -//[procedure DummyPaintProc] -procedure DummyPaintProc( Sender: PControl; DC: HDC ); -begin +function DummyProc123_0( Dummy: Pointer; Sender: PObj; param3: Integer ): Integer; +begin Result := 0; // 1-2-3 params, Result = 0 end; -{$IFDEF WIN} -{$ENDIF WIN} -{-} +function DummyProc4_TRUE( Dummy: Pointer; Sender: PControl; p3, p4: Integer ): Boolean; +begin Result := TRUE; // 4 params, result = TRUE +end; + +function DummyProc5_TRUE( Dummy: Pointer; Sender: PControl; p3, p4, p5: Integer): Boolean; +begin Result := TRUE; // 5 params, result = TRUE +end; + +procedure DummyOnLVDataProc( Dummy: Pointer; Sender: PControl; Idx, SubItem: Integer; + var Txt: KOL_String; var ImgIdx: Integer; var State: DWORD; + var Store: Boolean ); +begin // 8 params +end; + +function DummyProc4_0( Dummy: Pointer; Sender: PControl; p3, p4: Integer ): Integer; +begin Result := 0; // 4 params, Result = 0 +end; + +function DummyOnDrawItemProc( Dummy:Pointer; Sender: PObj; DC: HDC; const Rect: TRect; ItemIdx: Integer; + DrawAction: TDrawAction; ItemState: TDrawState ): Boolean; +begin Result := FALSE; // 7 params, Result = FALSE +end; + +function DummyOnLVCustomDrawProc( Dummy: Pointer; Sender: PControl; DC: HDC; Stage: DWORD; + ItemIdx, SubItemIdx: Integer; const Rect: TRect; + ItemState: TDrawState; var TextColor, BackColor: TColor ): DWORD; +begin Result := 0; // 10 params, Result = 0 +end; + +function DummyOnSBBeforeScrollProc(Dummy: Pointer; Sender: PControl; + OldPos, NewPos: Integer; Cmd: Word; var AllowChange: Boolean): Boolean; +begin Result := FALSE; // 6 params +end; + +var DummyProcTable: array[ 0..11 ] of Pointer = ( @DummyObjProc, @DummyProc123_TRUE, + @DummyProc123_0, @DummyProc4_TRUE, @DummyProc5_TRUE, @DummyOnLVDataProc, + @DummyProc4_0, @DummyOnDrawItemProc, @DummyOnLVCustomDrawProc, + @DummyOnSBBeforeScrollProc, @WndFunc, + {$IFDEF USE_GRAPHCTLS} @InvalidateWindowed {$ELSE} @DummyObjProc {$ENDIF} ); +const idummy123 = 0; //+ + idummy123_TRUE = 1; //+ + idummy123_0 = 2; //+ + idummy4_TRUE = 3; //+ + idummy5_TRUE = 4; //+ + idummy8 = 5; //+ + idummy4_0 = 6; //+ + idummy7 = 7; //+ + idummy10 = 8; //+ + idummy6 = 9; //+ + iWndFunc = 10; //+ + iInvalidateWindowed = 11; //+ +const InitEventsTable: array[ 0..idx_LastEvent ] of Byte = ( + idummy123_0 + iWndFunc shl 4, //idx_fOnMessage + idx_fWndFunc = 0; idx_fWndFunc = 69; + idummy123_0 + iInvalidateWindowed shl 4, //idx_fOldOnMessage + idx_fDoInvalidate = 1; idx_fDoInvalidate = 70; + idummy123 + idummy123_0 shl 4, //idx_fOnClick = 2; idx_fOnDynHandlers = 71; + idummy123 + idummy123_0 shl 4, //idx_fOnMouseDown = 3; idx_fPass2DefProc = 72; + idummy123 + idummy123_0 shl 4, //idx_fOnMouseUp = 4; idx_fWndProcKeybd = 73; + idummy123 + idummy123_0 shl 4, //idx_fOnMouseMove = 5; idx_fControlClick = 74; + idummy123 + idummy123_0 shl 4, //idx_fOnMouseDblClk = 6; idx_fAutoSize = 75; + idummy123 + idummy123_0 shl 4, //idx_fOnMouseWheel = 7; idx_fGotoControl = 77; + idummy123 + idummy123_0 shl 4, //idx_fOnMouseEnter = 8; idx_fNotifyChild = 78; + idummy123 + idummy123_0 shl 4, //idx_fOnMouseLeave = 9; idx_fScrollChildren = 79; + idummy123_TRUE + idummy123_0 shl 4, //idx_fOnTestMouseOver = 10; idx_fCreateWndExt = 80; + idummy123 + idummy123_0 shl 4, //idx_fGraphCtlMouseEvent = 11; idx_fExMsgProc = 81; + idummy123, //idx_fMouseLeaveProc = 12; + idummy5_TRUE, //idx_fOnScroll = 13; + idummy4_TRUE, //idx_fOnChar = 14; + idummy4_TRUE, //idx_fOnDeadChar = 15; + idummy4_TRUE, //idx_fOnKeyUp = 16; + idummy4_TRUE, //idx_fOnKeyDown = 17; + idummy123, //idx_fOnChange = 18; + idummy123, //idx_fOnEnter = 19; + idummy123, //idx_fOnLeave = 20; + idummy123, //idx_fLeave = 21; + idummy123, //idx_fOnPaint = 22; + idummy123, //idx_fOnPaint2 = 23; + idummy123, //idx_fOnPrepaint = 24; + idummy123, //idx_fOnPostPaint = 25; + idummy123, //idx_fPaintProc = 26; + idummy123, //idx_fOnEraseBkgnd = 27; + idummy7, //idx_fOnDrawItem = 28; + idummy123_0, //idx_fOnMeasureItem = 29; + idummy6, //idx_fDragCallback = 30; + idummy123, //idx_fOnSelChange = 31; + idummy123, //idx_fOnResize = 32; + idummy123, //idx_fOnHide = 33; + idummy123, //idx_fOnShow = 34; + idummy123, //idx_fOnClose = 35; + idummy123, //idx_fOnMove = 36; + idummy123, //idx_fOnMoving = 37; + idummy4_0, //idx_fOnHelp = 38; + idummy123, //idx_fOnQueryEndSession = 39; + idummy123, //idx_fOnMinimize = 40; + idummy123, //idx_fOnMaximize = 41; + idummy123, //idx_fOnRestore = 42; + idummy10, //idx_fOnLVCustomDraw = 43; + idummy5_TRUE, //idx_fOnEndEditLVITem = 44; + idummy8, //idx_fOnLVData = 45; + idummy4_0, //idx_fOnCompareLVItems = 46; + idummy6, //idx_FOnLVStateChange = 47; + idummy123, //idx_fOnDeleteLVItem = 48; + idummy123, //idx_fOnColumnClick = 49; + idummy4_TRUE, //idx_FOnTVEndEdit = 50; + idummy4_TRUE, //idx_FOnTVExpanded = 51; + idummy4_0, //idx_FOnTVExpanding = 52; + idummy4_TRUE, //idx_FOnTVSelChanging = 53; + idummy6, //idx_FOnSBBeforeScroll = 54; + idummy123, //idx_FOnSBScroll = 55; + idummy123, //idx_FOnDropDown = 56; + idummy123, //idx_FOnCloseUp = 57; + idummy4_TRUE, //idx_FOnSplit = 58; + idummy123, //idx_FOnProgress = 59; + idummy123_0, //idx_FOnBitBtnDraw = 60; + idummy123, //idx_FOnTVBeginDrag = 61; + idummy123_TRUE, //idx_FOnTVBeginEdit = 62; + idummy123, //idx_FOnTVDelete = 63; + idummy5_TRUE, //idx_FOnDTPUserString = 64; + idummy123, //idx_FOnREInsModeChg = 65; + idummy123, //idx_FOnREOverURL = 66; + idummy123, //idx_FOnREURLClick = 67; + idummy4_0 //idx_fOnDropFiles = 68; + ); + { _TObj } -//[procedure Free_And_Nil] procedure Free_And_Nil( var Obj ); var Obj1: PObj; begin @@ -14904,7 +15658,6 @@ begin Obj1.Free; end; -//[procedure _TObj.Init] procedure _TObj.Init; begin {$IFDEF _D2orD3} @@ -14912,7 +15665,6 @@ begin {$ENDIF} end; -//[function _TObj.VmtAddr] function _TObj.VmtAddr: Pointer; asm MOV EAX, [EAX] @@ -14937,21 +15689,15 @@ asm @@exit: end; -{+} - -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal constructor TObj.Create; begin Init; - {++}(* inherited; *){--} end; {$ENDIF ASM_VERSION} {$IFDEF OLD_REFCOUNT} -//[procedure TObj.DoDestroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TObj.DoDestroy; begin {$IFDEF OLD_REFCOUNT} @@ -14980,49 +15726,40 @@ end; {$ENDIF ASM_VERSION} {$ENDIF OLD_REFCOUNT} -//[procedure TObj.RefDec] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TObj.RefDec: Integer; begin Result := 0; // stop Delphi alerting the Warning - if @ Self = nil then Exit; + if @ Self = nil then Exit; Dec( fRefCount, 2 ); {$IFDEF OLD_REFCOUNT} - if (fRefCount < 0) and LongBool(fRefCount and 1) then - Destroy; + if (fRefCount < 0) and LongBool(fRefCount and 1) then + Destroy; {$ELSE} - if fRefCount < 0 then - Destroy; + if fRefCount < 0 then + Destroy; {$ENDIF} end; {$ENDIF ASM_VERSION} -//[procedure TObj.RefInc] procedure TObj.RefInc; begin Inc( fRefCount, 2 ); end; -{-} -//[function TObj.VmtAddr] function TObj.VmtAddr: Pointer; asm MOV EAX, [EAX - 4] end; -//[function TObj.InstanceSize] function TObj.InstanceSize: Integer; asm MOV EAX, [EAX] MOV EAX,[EAX-4] end; -{+} {$IFDEF OLD_FREE} -//[procedure TObj.Free] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} procedure TObj.Free; begin //if @ Self <> nil then @@ -15043,37 +15780,27 @@ begin Final; {$IFDEF DEBUG_ENDSESSION} - if EndSession_Initiated then - LogFileOutput( GetStartDir + 'es_debug.txt', + if EndSession_Initiated then + LogFileOutput( GetStartDir + 'es_debug.txt', 'FINALLED: ' + Int2Hex( DWORD( @ Self ), 8 ) {$IFDEF USE_NAMES} + ' (name:' + FName + ')' {$ENDIF} - ); + ); {$ENDIF} {$IFDEF USE_NAMES} fName := ''; - if fNamedObjList <> nil then Free_And_Nil(fNamedObjList); + if fNamedObjList <> nil then + Free_And_Nil(fNamedObjList); {$ENDIF} - {-} //Dispose( @Self ); {$IFDEF CRASH_DEBUG} FillChar( Pointer( Integer(@Self) + 4 )^, Sizeof( Self ) - 4, #$DD ); {$ENDIF} FreeMem( @ Self ); - {+} {++}(* - inherited; *){--} end; {$ENDIF ASM_VERSION} -{++}(* -//[procedure TObj.Init] -procedure TObj.Init; -begin - -end; -*){--} - {$IFDEF ASM_VERSION} {$DEFINE ASM_TLIST} {$IFDEF TLIST_FAST} @@ -15081,7 +15808,6 @@ end; {$ENDIF} {$ENDIF} -//[procedure TObj.Final] {$IFDEF ASM_TLIST} procedure TObj.Final; asm //cmd //opd @@ -15128,11 +15854,13 @@ var N: Integer; {$ELSE} Proc: TObjectMethod Absolute ProcMethod; {$ENDIF} +var Destroy_evnt: TOnEvent; begin if Assigned( fOnDestroy ) then begin - fOnDestroy( @Self ); + Destroy_evnt := fOnDestroy; fOnDestroy := nil; + Destroy_evnt( @Self ); end; while (fAutoFree <> nil) and (fAutoFree.fCount > 0) do begin @@ -15140,30 +15868,17 @@ begin ProcMethod.Code := fAutoFree.Items[ N ]; ProcMethod.Data := fAutoFree.Items[ N + 1 ]; fAutoFree.DeleteRange( N, 2 ); - {-} {$IFDEF _D2orD3} Proc := TObjectMethod( ProcMethod ); {$ENDIF} Proc; - {+}{++}(* - asm - MOV EAX, [ProcMethod.Data] - {$IFDEF F_P} - PUSH EAX - {$ENDIF F_P} - MOV ECX, [ProcMethod.Code] - CALL ECX - end {$IFDEF F_P}[ 'EAX', 'EDX', 'ECX' ]{$ENDIF}; - *){--} end; fAutoFree.Free; fAutoFree := nil; end; {$ENDIF ASM_VERSION} -//[procedure TObj.Add2AutoFree] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TObj.Add2AutoFree(Obj: PObj); begin if fAutoFree = nil then @@ -15173,9 +15888,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TObj.Add2AutoFreeEx] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION} {$ELSE ASM_VERSION} //Pascal procedure TObj.Add2AutoFreeEx( Proc: TObjectMethod ); {$IFDEF F_P} var Ptr1, Ptr2: Pointer; @@ -15199,9 +15912,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TObj.RemoveFromAutoFree] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} procedure TObj.RemoveFromAutoFree(Obj: PObj); var i: Integer; begin @@ -15301,7 +16012,7 @@ end; {$IFDEF USE_CONSTRUCTORS} procedure TList.Init; begin - {$IFDEF _D2orD3} + {$IFDEF CALL_INHERITED} inherited; {$ENDIF} fAddBy := 4; @@ -15312,21 +16023,22 @@ begin {$ENDIF} end; -//[function NewList] function NewList: PList; begin New( Result, Create ); + {$IFDEF DEBUG_OBJKIND} + fObjKind := 'TList'; + {$ENDIF} //Result.fAddBy := 4; end; -//[END NewList] {$ELSE not_USE_CONSTRUCTORS} -//[function NewList] function NewList: PList; begin - {-} New( Result, Create ); - {+} {++}(* Result := PList.Create; *){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TList'; + {$ENDIF} Result.fAddBy := 4; {$IFDEF TLIST_FAST} {$IFNDEF DFLT_TLIST_NOUSE_BLOCKS} // for debug only @@ -15334,10 +16046,8 @@ begin {$ENDIF} {$ENDIF} end; -//[END NewList] {$ENDIF USE_CONSTRUCTORS} -//[procedure TList.Init] {$IFDEF _D4orHigher} function NewListInit( const AItems: array of Pointer ): PList; var i: Integer; @@ -15349,7 +16059,6 @@ begin end; {$ENDIF} -//[procedure HelpFastIncNum2Els] procedure HelpFastIncNum2Els( DataArray: Pointer; Value, Count: Integer ); asm PUSH ESI @@ -15373,9 +16082,7 @@ asm POP EDI POP ESI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -//[END HelpFastIncNum2Els] -//[procedure FastIncNum2Elements] {$IFNDEF TLIST_FAST} procedure FastIncNum2Elements( List: TList; FromIdx, Count, Value: Integer ); begin @@ -15383,8 +16090,7 @@ begin end; {$ENDIF} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TList.Destroy; begin Clear; @@ -15392,7 +16098,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TList.Release] {$IFDEF ASM_TLIST} procedure TList.Release; asm @@ -15427,7 +16132,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TList.ReleaseObjects] procedure TList.ReleaseObjects; var I: Integer; begin @@ -15437,19 +16141,17 @@ begin Free; end; -//[procedure TList.SetCapacity] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal //var NewItems: PPointerList; procedure TList.SetCapacity( Value: Integer ); begin {$IFDEF TLIST_FAST} - if Value > 256 then // Capacitity в обычном смысле работает только для первого - Value := 256; // блока - до 256 элементов, далее оно смысла не имеет, - // т.к. все прочие блоки всегда содержат по 256 позиций - // для элементов, независимо от процента использования. - if fUseBlocks and (Assigned( fBlockList ) {or (Value > 256)}) then + if fUseBlocks and (fBlockList <> nil) then begin + if Value > 256 then // Capacitity в обычном смысле работает только для первого + Value := 256; // блока - до 256 элементов, далее оно смысла не имеет, + // т.к. все прочие блоки всегда содержат по 256 позиций + // для элементов, независимо от процента использования. fCapacity := Value; end else @@ -15464,9 +16166,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TList.Clear] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TList.Clear; {$IFDEF TLIST_FAST} var i: Integer; @@ -15490,14 +16190,12 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TList.SetAddBy] procedure TList.SetAddBy(Value: Integer); begin if Value < 1 then Value := 1; fAddBy := Value; end; -//[procedure TList.Add] {$IFDEF ASM_NO_VERSION} /// ASM-version disabled due some problems - 20-May-2010 {$ELSE ASM_VERSION} //Pascal procedure TList.Add( Value: Pointer ); @@ -15507,7 +16205,7 @@ var LastBlockCount: Integer; {$ENDIF} begin {$IFDEF TLIST_FAST} - if fUseBlocks and ((fCount >= 256) or Assigned( fBlockList )) then + if fUseBlocks and ((fCount >= 256) or ( fBlockList <> nil )) then begin if fBlockList = nil then begin @@ -15525,7 +16223,7 @@ begin end else begin - LastBlockCount := Integer( fBlockList.fItems[ fBlockList.fCount-1 ] ); + LastBlockCount := Integer( fBlockList.Items[ fBlockList.fCount-1 ] ); if LastBlockCount >= 256 then begin fBlockList.Add( nil ); @@ -15569,13 +16267,11 @@ begin end; {$ENDIF} -//[procedure TList.Delete] procedure TList.Delete( Idx: Integer ); begin DeleteRange( Idx, 1 ); end; -//[procedure TList.DeleteRange] {$IFDEF ASM_TLIST} procedure TList.DeleteRange(Idx, Len: Integer); asm //cmd //opd @@ -15619,7 +16315,7 @@ begin if DWORD( Idx + Len ) > DWORD( Count ) then Len := Count - Idx; {$IFDEF TLIST_FAST} - if fUseBlocks and Assigned( fBlockList ) then + if fUseBlocks and ( fBlockList <> nil ) then begin CountBefore := 0; i := 0; @@ -15677,12 +16373,12 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TList.Remove] -function TList.Remove(Value: Pointer): Integer; +procedure TList.Remove(Value: Pointer); +var I: Integer; begin - Result := IndexOf( Value ); - if Result >= 0 then - Delete( Result ); + I := IndexOf( Value ); + if I >= 0 then + Delete( I ); end; function TList.ItemAddress(Idx: Integer): Pointer; @@ -15693,7 +16389,7 @@ var i: Integer; {$ENDIF} begin {$IFDEF TLIST_FAST} - if fUseBlocks and Assigned( fBlockList ) then + if fUseBlocks and ( fBlockList <> nil ) then begin CountBefore := 0; i := 0; @@ -15740,67 +16436,7 @@ begin Result := Pointer( Integer( fItems ) + Idx * Sizeof( Pointer ) ); end; -//[procedure TList.Put] -{$IFDEF ASM_VERSION} -procedure TList.Put( Idx: Integer; Value: Pointer ); -asm - TEST EDX, EDX - JL @@exit - CMP EDX, [EAX].fCount - JGE @@exit - PUSH ESI - MOV ESI, ECX - {$IFDEF TLIST_FAST} - CMP [EAX].fUseBlocks, 0 - JZ @@old - MOV ECX, [EAX].fBlockList - JECXZ @@old - PUSH EBX - PUSH ESI - PUSH EDI - PUSH EBP - XCHG EBX, EAX // EBX == @Self - XOR ECX, ECX // CountBefore := 0; - XOR EAX, EAX // i := 0; - CMP [EBX].fLastKnownBlockIdx, 0 - JLE @@1 - CMP EDX, [EBX].fLastKnownCountBefore - JL @@1 - MOV ECX, [EBX].fLastKnownCountBefore - MOV EAX, [EBX].fLastKnownBlockIdx -@@1: - MOV ESI, [EBX].fBlockList - MOV ESI, [ESI].fItems - MOV EDI, [ESI+EAX*8] // EDI = BlockStart - MOV ESI, [ESI+EAX*8+4] // ESI = CountCurrent - CMP ECX, EDX - JG @@next - LEA EBP, [ECX+ESI] - CMP EDX, EBP - JGE @@next - MOV [EBX].fLastKnownBlockIdx, EAX - MOV [EBX].fLastKnownCountBefore, ECX - SUB EDX, ECX - LEA EAX, [EDI+EDX*4] - POP EBP - POP EDI - POP ESI - POP EBX - MOV [EAX], ESI - POP ESI - RET -@@next: - ADD ECX, ESI - INC EAX - JMP @@1 -@@old: - {$ENDIF} - MOV EAX, [EAX].fItems - MOV [EAX+EDX*4], ESI - POP ESI -@@exit: -end; -{$ELSE not ASM_VERSION} +{$IFDEF ASM_VERSION}{$ELSE not ASM_VERSION} procedure TList.Put( Idx: Integer; Value: Pointer ); {$IFDEF TLIST_FAST} var i: Integer; @@ -15811,7 +16447,7 @@ begin if Idx < 0 then Exit; if Idx >= Count then Exit; {$IFDEF TLIST_FAST} - if fUseBlocks and Assigned( fBlockList ) then + if fUseBlocks and ( fBlockList <> nil ) then begin CountBefore := 0; i := 0; @@ -15843,64 +16479,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TList.Get] -{$IFDEF ASM_VERSION} -function TList.Get( Idx: Integer ): Pointer; -asm - TEST EDX, EDX - JL @@ret_nil - CMP EDX, [EAX].fCount - JGE @@ret_nil - {$IFDEF TLIST_FAST} - CMP [EAX].fUseBlocks, 0 - JZ @@old - MOV ECX, [EAX].fBlockList - JECXZ @@old - PUSH EBX - PUSH ESI - PUSH EDI - PUSH EBP - XCHG EBX, EAX // EBX == @Self - XOR ECX, ECX // CountBefore := 0; - XOR EAX, EAX // i := 0; - CMP [EBX].fLastKnownBlockIdx, 0 - JLE @@1 - CMP EDX, [EBX].fLastKnownCountBefore - JL @@1 - MOV ECX, [EBX].fLastKnownCountBefore - MOV EAX, [EBX].fLastKnownBlockIdx -@@1: - MOV ESI, [EBX].fBlockList - MOV ESI, [ESI].fItems - MOV EDI, [ESI+EAX*8] // EDI = BlockStart - MOV ESI, [ESI+EAX*8+4] // ESI = CountCurrent - CMP ECX, EDX - JG @@next - LEA EBP, [ECX+ESI] - CMP EDX, EBP - JGE @@next - MOV [EBX].fLastKnownBlockIdx, EAX - MOV [EBX].fLastKnownCountBefore, ECX - SUB EDX, ECX - MOV EAX, [EDI+EDX*4] - POP EBP - POP EDI - POP ESI - POP EBX - RET -@@next: - ADD ECX, ESI - INC EAX - JMP @@1 -@@old: - {$ENDIF} - MOV EAX, [EAX].fItems - MOV EAX, [EAX+EDX*4] - RET -@@ret_nil: - XOR EAX, EAX -end; -{$ELSE not ASM_VERSION} +{$IFDEF ASM_VERSION}{$ELSE not ASM_VERSION} function TList.Get( Idx: Integer ): Pointer; {$IFDEF TLIST_FAST} var i: Integer; @@ -15912,7 +16491,7 @@ begin if Idx < 0 then Exit; if Idx >= fCount then Exit; {$IFDEF TLIST_FAST} - if fUseBlocks and Assigned( fBlockList ) then + if fUseBlocks and ( fBlockList <> nil ) then begin CountBefore := 0; i := 0; @@ -15943,7 +16522,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TList.IndexOf] {$IFDEF ASM_TLIST} function TList.IndexOf( Value: Pointer ): Integer; asm @@ -15984,7 +16562,7 @@ begin TRY {$ENDIF} {$IFDEF TLIST_FAST} - if fUseBlocks and Assigned( fBlockList ) then + if fUseBlocks and ( fBlockList <> nil ) then begin CountBefore := 0; for I := 0 to fBlockList.fCount div 2 - 1 do @@ -16025,7 +16603,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TList.Insert] {$IFDEF ASM_TLIST} procedure TList.Insert(Idx: Integer; Value: Pointer); asm @@ -16063,9 +16640,9 @@ var i: Integer; begin Assert( (Idx >= 0) and (Idx <= FCount+1), 'List index out of bounds' ); {$IFDEF TLIST_FAST} - if fUseBlocks and (Assigned( fBlockList ) or (fCount >= 256)) then + if fUseBlocks and (( fBlockList <> nil ) or (fCount >= 256)) then begin - if not Assigned( fBlockList ) then + if ( fBlockList = nil ) then begin fBlockList := NewList; fBlockList.fUseBlocks := FALSE; @@ -16151,7 +16728,6 @@ end; {$IFDEF ASM_VERSION} {$DEFINE MoveItem_ASM} {$ENDIF} {$IFDEF TLIST_FAST} {$UNDEF MoveItem_ASM} {$ENDIF} -//[procedure TList.MoveItem] {$IFDEF MoveItem_ASM} {$ELSE ASM_VERSION} //Pascal procedure TList.MoveItem(OldIdx, NewIdx: Integer); @@ -16165,9 +16741,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TList.Last] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TList.Last: Pointer; begin if Count = 0 then @@ -16177,7 +16751,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TList.Swap] {$IFDEF ASM_TLIST} procedure TList.Swap(Idx1, Idx2: Integer); asm @@ -16208,14 +16781,12 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TList.SetCount] procedure TList.SetCount(const Value: Integer); begin if Value >= Count then exit; fCount := Value; end; -//[procedure TList.Assign] procedure TList.Assign(SrcList: PList); {$IFDEF TLIST_FAST} var i, CountCurrent: Integer; @@ -16226,7 +16797,7 @@ begin if SrcList.fCount > 0 then begin {$IFDEF TLIST_FAST} - if SrcList.fUseBlocks and Assigned( SrcList.fBlockList ) then + if SrcList.fUseBlocks and ( SrcList.fBlockList <> nil ) then begin fBlockList := NewList; fBlockList.Assign( SrcList.fBlockList ); @@ -16251,105 +16822,6 @@ end; {$IFDEF WIN_GDI} -{ -- Window procedure -- } -(* -function CallCtlWndProc_1( Ctl: PControl; var Msg: TMsg ): Integer; -begin - Result := Ctl.WndProc( Msg ); -end; -function WndFunc_asm( W: HWnd; Msg: Cardinal; wParam, lParam: Integer ) - : Integer; stdcall; -const size_TMsg = sizeof( TMsg ); -asm - ADD ESP, -size_TMsg - MOV EDX, ESP - - PUSH ESI - PUSH EDI - - MOV EDI, EDX - LEA ESI, [W] - - MOVSD - MOVSD - MOVSD - MOVSD - - MOV EDI, EDX - MOV EAX, [EDI] - TEST EAX, EAX - JZ @@self_is_nil - - MOV ECX, [CreatingWindow] - JECXZ @@get_self_prop - - MOV [ECX].TControl.fHandle, EAX - - PUSH ECX - PUSH ECX - {$IFDEF USE_PROP} - PUSH Offset[ID_SELF] - PUSH EAX - CALL SetProp - {$ELSE} - PUSH GWL_USERDATA - PUSH EAX - CALL SetWindowLong - {$ENDIF} - - XOR EAX, EAX - MOV [CreatingWindow], EAX - POP EAX // EAX = self_ - JMP @@self_got - -@@get_self_prop: - {$IFDEF USE_PROP} - PUSH Offset[ID_SELF] - PUSH EAX - CALL GetProp - {$ELSE} - PUSH GWL_USERDATA - PUSH EAX - CALL GetWindowLong - {$ENDIF} - TEST EAX, EAX - JNZ @@self_got - -@@self_is_nil: - OR EAX, [ Applet ] - JNZ @@self_got - - POP EDI - POP ESI - MOV ESP, EBP - POP EBP - JMP DefWindowProc - -@@self_got: - MOV ESI, EAX - INC [ESI].TControl.fNestedMsgHandling - MOV EDX, EDI - CALL CallCtlWndProc_1 - DEC [ESI].TControl.fNestedMsgHandling - JG @@1 - CMP [ESI].TControl.fBeginDestroying, 0 - JZ @@1 - CMP [ESI].TObj.fRefCount, 0 - JNZ @@1 - CMP ESI, [Applet] - JZ @@1 - XCHG EAX, ESI - CALL TObj.RefDec - XCHG ESI, EAX -@@1: - - POP EDI - POP ESI - - MOV ESP, EBP -end; -*) - {$UNDEF ASM_LOCAL} {$IFDEF ASM_noVERSION} {$IFNDEF _D2orD3} @@ -16358,14 +16830,12 @@ end; {$ENDIF} {$IFDEF ASM_LOCAL} //!!//!! -//[FUNCTION CallCtlWndProc] function CallCtlWndProc( Ctl: PControl; var Msg: TMsg ): Integer; begin Result := Ctl.WndProc( Msg ); end; -//[END CallCtlWndProc] -//[function WndFunc] +{ -- Window procedure -- } function WndFunc( W: HWnd; Msg: Cardinal; wParam, lParam: Integer ) : Integer; stdcall; const size_TMsg = sizeof( TMsg ); @@ -16436,13 +16906,18 @@ asm @@self_got: MOV ESI, EAX - INC [ESI].TControl.fNestedMsgHandling + INC WORD PTR [ESI].TControl.fNestedMsgHandling MOV EDX, EDI CALL CallCtlWndProc - DEC [ESI].TControl.fNestedMsgHandling + DEC WORD PTR [ESI].TControl.fNestedMsgHandling JA @@1 + {$IFDEF USE_FLAGS} + TEST [ESI].TControl.fFlagsG2, (1 shl G2_BeginDestroying) + JZ @@1 + {$ELSE} CMP [ESI].TControl.fBeginDestroying, 0 JZ @@1 + {$ENDIF} CMP [ESI].TObj.fRefCount, 0 JNZ @@1 CMP ESI, [Applet] @@ -16532,14 +17007,22 @@ begin Log( '//// self_ <> nil, calling self_.WndProc' ); {$ENDIF INPACKAGE} inc( self_.fNestedMsgHandling ); + {$IFDEF DEBUG_KEYDOWN} + if M.message = WM_KEYDOWN then + asm + nop + end; + {$ENDIF} Result := self_.WndProc( M ); dec( self_.fNestedMsgHandling ); - if (self_.RefCount = 0) and (self_.fNestedMsgHandling <= 0) and - self_.fBeginDestroying and (self_ <> Applet) then + if (self_.fRefCount = 0) and (self_.fNestedMsgHandling <= 0) + and {$IFDEF USE_FLAGS} (G2_BeginDestroying in self_.fFlagsG2) + {$ELSE} self_.fBeginDestroying {$ENDIF} + and (self_ <> Applet) then self_.Free; end else - if Assigned( Applet ) then + if ( Applet <> nil ) then Result := Applet.WndProc( M ) else Result := DefWindowProc( W, Msg, wParam, lParam ); @@ -16558,14 +17041,12 @@ begin END; {$ENDIF INPACKAGE} end; -//[END WndFunc] {$ENDIF ASM_VERSION} var IdleHandlers: PList; ProcessIdle: procedure ( Sender: PObj ) = DummyObjProc; -//[procedure ProcessIdleProc] procedure ProcessIdleProc( Sender: PObj ); var i: integer; @@ -16573,7 +17054,7 @@ var begin if AppletTerminated then exit; // YS + i := 0; - with IdleHandlers{-}^{+} do + with IdleHandlers^ do while i < Count do begin m.Code:=Items[i]; Inc(i); @@ -16583,14 +17064,13 @@ begin end; end; -//[function FindIdleHandler] function FindIdleHandler( const OnIdle: TOnEvent ): integer; var i: integer; begin i := 0; if not AppletTerminated then //+ {Maxim Pushkar} - with TMethod(OnIdle), IdleHandlers{-}^{+} do + with TMethod(OnIdle), IdleHandlers^ do while i < Count do begin if (Items[i] = Code) and (Items[i + 1] = Data) then begin @@ -16601,9 +17081,7 @@ begin end; Result := -1; end; -//[END FindIdleHandler] -//[procedure RegisterIdleHandler] procedure RegisterIdleHandler( const OnIdle: TOnEvent ); begin if IdleHandlers = nil then begin @@ -16619,14 +17097,13 @@ begin ProcessIdle := @ProcessIdleProc; end; -//[procedure UnRegisterIdleHandler] procedure UnRegisterIdleHandler( const OnIdle: TOnEvent ); var i: integer; begin i := FindIdleHandler(OnIdle); if i <> -1 then - with IdleHandlers{-}^{+} do + with IdleHandlers^ do begin Delete(i); Delete(i); @@ -16634,7 +17111,6 @@ begin end; {$IFDEF GDI} -//[procedure TerminateExecution] {$IFDEF ASM_noVERSION} procedure TerminateExecution( var AppletWnd: PControl ); asm @@ -16698,7 +17174,6 @@ begin end; {$ENDIF ASM_VERSION} -//[PROCEDURE CallTControlCreateWindow] //22{$IFDEF ASM_VERSION} function CallTControlCreateWindow( Ctl: PControl ): Boolean; begin @@ -16717,14 +17192,11 @@ begin {$ENDIF} end; //22{$ENDIF} -//[END CallTControlCreateWindow] {$ENDIF GDI} {$ENDIF WIN_GDI} {$IFDEF GDI} -//[PROCEDURE Run] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure Run( var AppletWnd: PControl ); {$IFDEF PSEUDO_THREADS} var n: Integer; @@ -16740,7 +17212,7 @@ begin while not AppletTerminated do begin {$IFDEF PSEUDO_THREADS} - if Assigned( MainThread ) then + if ( MainThread <> nil ) then begin while not PeekMessage( M, 0, 0, 0, pm_noremove ) do begin @@ -16772,34 +17244,31 @@ begin if AppletWnd <> nil then TerminateExecution( AppletWnd ); end; -//[END Run] {$ENDIF ASM_VERSION} {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} - procedure Run( var AppletWnd: PControl ); - begin + PROCEDURE Run( var AppletWnd: PControl ); + BEGIN AppletRunning := True; Applet := AppletWnd; AppletWnd.VisualizyWindow; // for GTK, show all windows having Visible = TRUE, recursively gtk_main( ); - if AppletWnd <> nil then - //TerminateExecution( AppletWnd ); - Free_And_Nil( AppletWnd ); - end; + IF AppletWnd <> nil THEN + //TerminateExecution( AppletWnd ); + Free_And_Nil( AppletWnd ); + END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} {$IFDEF GDI} -//[procedure AppletMinimize] procedure AppletMinimize; begin if Applet = nil then Exit; Applet.Perform( WM_SYSCOMMAND, SC_MINIMIZE, 0 ); end; -//[procedure AppletHide] procedure AppletHide; begin if Applet = nil then Exit; @@ -16807,7 +17276,6 @@ begin Applet.Hide; end; -//[procedure AppletRestore] procedure AppletRestore; begin if Applet = nil then Exit; @@ -16815,22 +17283,17 @@ begin Applet.Perform( WM_SYSCOMMAND, SC_RESTORE, 0 ); end; -//[function ScreenWidth] function ScreenWidth: Integer; begin Result := GetSystemMetrics( SM_CXSCREEN ); end; -//[END ScreenWidth] -//[function ScreenHeight] function ScreenHeight: Integer; begin Result := GetSystemMetrics( SM_CYSCREEN ); end; -//[END ScreenHeight] {$ENDIF GDI} -//[WndProcXXX FORWARD DECLARATIONS] //22{$IFDEF ASM_VERSION} function WndProcAppAsm( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward; //22{$ENDIF} @@ -16844,42 +17307,47 @@ function WndProcNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boo function WndProcCommonNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward; var fGlobalProcKeybd: function( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean = WndProcDummy; -//[END OF WndProcXXX FORWARD DECLARATIONS] { -- Graphics support -- } {$ENDIF WIN_GDI} -//[function _NewGraphicTool] function _NewGraphicTool: PGraphicTool; begin - {-} New( Result, Create ); - {+} - {++}(*Result := PGraphicTool.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TGraphicTool'; + {$ENDIF} end; -//[END _NewGraphicTool] {$IFDEF WIN_GDI} -//[FUNCTION SimpleGetCtlBrushHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION PAS_VERSION} +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION PAS_VERSION} function SimpleGetCtlBrushHandle( Sender: PControl ): HBrush; +{$IFDEF STORE_fTmpBrushColorRGB}{$ELSE} +var tmpRGBColor: TColor; +{$ENDIF} begin if (Sender.fParent <> nil) and (Sender.fColor = Sender.fParent.fColor) then Result := SimpleGetCtlBrushHandle( Sender.fParent ) else begin {$IFDEF GDI} + {$IFDEF STORE_fTmpBrushColorRGB} if (Sender.fTmpBrush <> 0) and (Color2RGB( Sender.fColor ) <> Sender.fTmpBrushColorRGB) then begin DeleteObject( Sender.fTmpBrush ); Sender.fTmpBrush := 0; end; + {$ENDIF} if Sender.fTmpBrush = 0 then begin + {$IFDEF STORE_fTmpBrushColorRGB} Sender.fTmpBrushColorRGB := Color2RGB( Sender.fColor ); Sender.fTmpBrush := CreateSolidBrush( Sender.fTmpBrushColorRGB ); + {$ELSE} + tmpRGBColor := Color2RGB( Sender.fColor ); + Sender.fTmpBrush := CreateSolidBrush( tmpRGBColor ); + {$ENDIF} end; Result := Sender.fTmpBrush; {$ELSE} Result := 0; @@ -16887,9 +17355,7 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END SimpleGetCtlBrushHandle] -//[function NormalGetCtlBrushHandle] function NormalGetCtlBrushHandle( Sender: PControl ): HBrush; begin {$IFDEF GDI} @@ -16899,31 +17365,21 @@ begin {$ELSE} Result := 0; {$ENDIF GDI} end; -//[END NormalGetCtlBrushHandle] -{++}(* -//[API CreateFontIndirect] -function CreateFontIndirect(const p1: TLogFont): HFONT; stdcall; -external gdi32 name 'CreateFontIndirectA'; -*){--} -//[MakeXXXHandle FORWARD DECLARATIONS] function MakeFontHandle( Self_: PGraphicTool ): THandle; forward; function MakeBrushHandle( Self_: PGraphicTool ): THandle; forward; function MakePenHandle( Self_: PGraphicTool ): THandle; forward; function MakeGeometricPenHandle( Self_: PGraphicTool ): THandle; forward; -//[END OF MakeXXXHandle FORWARD DECLARATIONS] {$ENDIF WIN_GDI} -//[FUNCTION NewBrush] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewBrush: PGraphicTool; begin {$IFDEF GDI} Global_GetCtlBrushHandle := NormalGetCtlBrushHandle; {$ENDIF GDI} Result := _NewGraphicTool; - with Result {-}^{+} do + with Result^ do begin fNewProc := @ NewBrush; fType := gttBrush; @@ -16935,15 +17391,12 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END NewBrush] -//[FUNCTION NewPen] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewPen: PGraphicTool; begin Result := _NewGraphicTool; - with Result{-}^{+} do + with Result^ do begin fNewProc := @ NewPen; fType := gttPen; @@ -16954,9 +17407,8 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END NewPen] -var ApplyFont2Wnd_Proc: procedure( _Self: PControl ) = nil; +var ApplyFont2Wnd_Proc: procedure( _Self: PObj ) = DummyObjProc; procedure DoApplyFont2Wnd( _Self: PControl ); forward; const size_FontData = sizeof( Integer {fFontHeight} ) + sizeof( Integer {fFontWidth} ) + @@ -16965,14 +17417,12 @@ const size_FontData = sizeof( Integer {fFontHeight} ) + sizeof( Integer {fFontWi sizeof( Integer {fFontWeight} ) + sizeof( TFontCharset ) + sizeof( TFontQuality ); -//[FUNCTION NewFont] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewFont: PGraphicTool; begin ApplyFont2Wnd_Proc := @ DoApplyFont2Wnd; Result := _NewGraphicTool; - with Result {-}^{+} do + with Result^ do begin fNewProc := @ NewFont; fType := gttFont; @@ -16987,20 +17437,16 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END NewFont] -//[function Color2RGB] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} function Color2RGB( Color: TColor ): TColor; begin - if Color < 0 then - Result := GetSysColor(Color and $7F) + if Color < 0 then + Result := GetSysColor(Color and $7F) else - Result := Color; + Result := Color; end; {$ENDIF ASM_VERSION} -//[END Color2RGB] function RGB2BGR( Color: TColor ): TColor; begin @@ -17008,7 +17454,6 @@ begin and $FFFFFF; end; -//[function ColorsMix] function ColorsMix( Color1, Color2: TColor ): TColor; {$IFDEF F_P} begin @@ -17029,12 +17474,9 @@ asm ADD EAX, EDX end; {$ENDIF F_P/DELPHI} -//[END ColorsMix] {$IFDEF WIN_GDI} -//[FUNCTION Color2RGBQuad] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function Color2RGBQuad( Color: TColor ): TRGBQuad; var C: Integer; begin @@ -17045,11 +17487,8 @@ begin Result := TRGBQuad( C ); end; {$ENDIF ASM_VERSION} -//[END Color2RGBQuad] -//[FUNCTION Color2Color16] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} function Color2Color16( Color: TColor ): WORD; begin Color := Color2RGB( Color ); @@ -17058,9 +17497,7 @@ begin (Color shl 8) and $F800; end; {$ENDIF ASM_VERSION} -//[END Color2Color16] -//[FUNCTION Color2Color15] function Color2Color15( Color: TColor ): WORD; begin Color := Color2RGB( Color ); @@ -17068,14 +17505,11 @@ begin (Color shr 6) and $3E0 or (Color shl 7) and $7C00; end; -//[END Color2Color15] {$ENDIF WIN_GDI} { TGraphicTool } -//[function TGraphicTool.Assign] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} function TGraphicTool.Assign(Value: PGraphicTool): PGraphicTool; var _Self: PGraphicTool; begin @@ -17107,7 +17541,6 @@ end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[procedure TGraphicTool.AssignHandle] procedure TGraphicTool.AssignHandle(NewHandle: Integer); begin if fHandle <> 0 then // @@ -17118,9 +17551,7 @@ begin end; {$ENDIF WIN_GDI} -//[procedure TGraphicTool.Changed] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TGraphicTool.Changed; {$IFDEF GDI} var H: THandle; {$ENDIF GDI} begin @@ -17132,8 +17563,8 @@ begin fHandle := 0; end; //////////////////////////////// - if Assigned( fOnChange ) then - fOnChange( @Self ); + if Assigned( fOnChange ) then + fOnChange( @Self ); //////////////////////////////// if H <> 0 then begin @@ -17148,20 +17579,20 @@ begin end; {$ENDIF GDI} {$IFDEF GTK} - if Assigned( fPangoFontDesc ) then - begin - pango_font_description_free( fPangoFontDesc ); - fPangoFontDesc := nil; - end; - if Assigned( fOnChange ) then - fOnChange( @Self ); + IF Assigned( fPangoFontDesc ) THEN + BEGIN + pango_font_description_free( fPangoFontDesc ); + fPangoFontDesc := nil; + END; + ///////////////////////////////// + IF Assigned( fOnChange ) THEN + ///////////////////////////////// + fOnChange( @Self ); {$ENDIF GTK} end; {$ENDIF ASM_VERSION} -//[destructor TGraphicTool.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TGraphicTool.Destroy; begin {$IFDEF GDI} @@ -17189,15 +17620,12 @@ end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[function TGraphicTool.HandleAllocated] function TGraphicTool.HandleAllocated: Boolean; begin Result := fHandle <> 0; end; -//[function TGraphicTool.ReleaseHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION PAS_VERSION} +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION PAS_VERSION} function TGraphicTool.ReleaseHandle: Integer; begin Changed; @@ -17207,9 +17635,7 @@ end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[procedure TGraphicTool.SetInt] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TGraphicTool.SetInt( const Index: Integer; Value: Integer ); var Where: PInteger; begin @@ -17220,7 +17646,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TGraphicTool.GetInt] function TGraphicTool.GetInt(const Index: Integer): Integer; var Where: PInteger; begin @@ -17230,7 +17655,6 @@ end; {$IFDEF WIN_GDI} {$ENDIF WIN_GDI} -//[procedure TGraphicTool.SetColor] procedure TGraphicTool.SetColor( Value: TColor ); begin SetInt( go_Color, Value ); @@ -17238,9 +17662,7 @@ begin end; {$IFDEF WIN_GDI} -//[function TGraphicTool.IsFontTrueType] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TGraphicTool.IsFontTrueType: Boolean; var OldFont: HFont; DC: HDC; @@ -17256,13 +17678,11 @@ begin end; {$ENDIF ASM_VERSION} -//[function TGraphicTool.GetBrushBitmap] function TGraphicTool.GetBrushBitmap: HBitmap; begin Result := fData.Brush.Bitmap; // for BCB only end; -//[procedure TGraphicTool.SetBrushBitmap] procedure TGraphicTool.SetBrushBitmap(const Value: HBitmap); begin if fData.Brush.Bitmap = Value then Exit; @@ -17275,14 +17695,12 @@ begin Changed; end; -//[function TGraphicTool.GetBrushStyle] function TGraphicTool.GetBrushStyle: TBrushStyle; begin Result := fData.Brush.Style; // for BCB only end; {$ENDIF WIN_GDI} -//[procedure TGraphicTool.SetBrushStyle] procedure TGraphicTool.SetBrushStyle(const Value: TBrushStyle); begin if fData.Brush.Style = Value then Exit; @@ -17291,13 +17709,11 @@ begin end; {$IFDEF WIN_GDI} -//[function TGraphicTool.GetFontCharset] function TGraphicTool.GetFontCharset: TFontCharset; begin Result := fData.Font.CharSet; // for BCB only end; -//[procedure TGraphicTool.SetFontCharset] procedure TGraphicTool.SetFontCharset(const Value: TFontCharset); begin if fData.Font.Charset = Value then Exit; @@ -17305,13 +17721,11 @@ begin Changed; end; -//[function TGraphicTool.GetFontQuality] function TGraphicTool.GetFontQuality: TFontQuality; begin Result := fData.Font.Quality; // for BCB only end; -//[procedure TGraphicTool.SetFontQuality] procedure TGraphicTool.SetFontQuality(const Value: TFontQuality); begin if fData.Font.Quality = Value then Exit; @@ -17320,17 +17734,15 @@ begin end; {$ENDIF WIN_GDI} -//[function TGraphicTool.GetFontName] function TGraphicTool.GetFontName: KOLString; begin Result := fData.Font.Name; {$IFDEF GTK} - if Result = '' then - Result := 'Sans Serif'; + IF Result = '' THEN + Result := 'Sans Serif'; {$ENDIF GTK} end; -//[procedure TGraphicTool.SetFontName] procedure TGraphicTool.SetFontName(const Value: KOLString); begin if fData.Font.Name = Value then Exit; @@ -17341,9 +17753,7 @@ begin end; {$IFDEF WIN_GDI} -//[procedure TextAreaEx] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TextAreaEx( Sender: PCanvas; var Sz : TSize; var Pt : TPoint ); var Orient : Integer; Pts : array[ 1..4 ] of TPoint; @@ -17386,32 +17796,27 @@ begin end; {$ENDIF ASM_VERSION} -//[function TGraphicTool.GetFontOrientation] function TGraphicTool.GetFontOrientation: Integer; begin Result := fData.Font.Orientation; // for BCB only end; -//[procedure TGraphicTool.SetFontOrientation] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TGraphicTool.SetFontOrientation(Value: Integer); begin GlobalGraphics_UseFontOrient := True; - GlobalCanvas_OnTextArea := TextAreaEx; + TOnTextArea( GlobalCanvas_OnTextArea ) := TextAreaEx; Value := Value mod 3600; // -3599..+3599 SetInt( go_FontOrientation, Value ); SetInt( go_FontEscapement, Value ); end; {$ENDIF ASM_VERSION} -//[function TGraphicTool.GetFontPitch] function TGraphicTool.GetFontPitch: TFontPitch; begin Result := fData.Font.Pitch; // for BCB only end; -//[procedure TGraphicTool.SetFontPitch] procedure TGraphicTool.SetFontPitch(const Value: TFontPitch); begin if fData.Font.Pitch = Value then Exit; @@ -17420,23 +17825,19 @@ begin end; {$ENDIF WIN_GDI} -//[function TGraphicTool.GetFontStyle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TGraphicTool.GetFontStyle: TFontStyle; type PFontStyle = ^TFontStyle; begin Result := [ ]; if fData.Font.Weight >= 700 then Result := [ fsBold ]; - if fData.Font.Italic then Result := Result + [ fsItalic ]; - if fData.Font.Underline then Result := Result + [ fsUnderline ]; - if fData.Font.StrikeOut then Result := Result + [ fsStrikeOut ]; + if fData.Font.Italic then include( Result, fsItalic ); + if fData.Font.Underline then include( Result, fsUnderline ); + if fData.Font.StrikeOut then include( Result, fsStrikeOut ); end; {$ENDIF ASM_VERSION} -//[procedure TGraphicTool.SetFontStyle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TGraphicTool.SetFontStyle(const Value: TFontStyle); begin if FontStyle = Value then Exit; @@ -17458,13 +17859,11 @@ end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[function TGraphicTool.GetPenMode] function TGraphicTool.GetPenMode: TPenMode; begin Result := fData.Pen.Mode; // for BCB only end; -//[procedure TGraphicTool.SetPenMode] procedure TGraphicTool.SetPenMode(const Value: TPenMode); begin if fData.Pen.Mode = Value then Exit; @@ -17472,13 +17871,11 @@ begin Changed; end; -//[function TGraphicTool.GetPenStyle] function TGraphicTool.GetPenStyle: TPenStyle; begin Result := fData.Pen.Style; // for BCB only end; -//[procedure TGraphicTool.SetPenStyle] procedure TGraphicTool.SetPenStyle(const Value: TPenStyle); begin if fData.Pen.Style = Value then Exit; @@ -17486,9 +17883,7 @@ begin Changed; end; -//[function TGraphicTool.GetHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TGraphicTool.GetHandle: THandle; begin Result := fHandle; @@ -17502,7 +17897,7 @@ begin end; if Result = 0 then begin - if Assigned( fParentGDITool ) then + if ( fParentGDITool <> nil ) then begin if CompareMem( @ fData, @ fParentGDITool.fData, Sizeof( fData ) ) then begin @@ -17517,9 +17912,7 @@ begin end; {$ENDIF ASM_VERSION} -//[FUNCTION MakeBrushHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function MakeBrushHandle( Self_: PGraphicTool ): THandle; var LogBrush: TLogBrush; @@ -17556,7 +17949,6 @@ begin Result := Self_.fHandle; end; {$ENDIF ASM_VERSION} -//[END MakeBrushHandle] {$UNDEF ASM_LOCAL} {$IFNDEF UNICODE_CTRLS} @@ -17567,7 +17959,6 @@ end; {$ENDIF ASM_VERSION} {$ENDIF} -//[FUNCTION MakeFontHandle] {$IFDEF ASM_LOCAL} function MakeFontHandle( Self_: PGraphicTool ): THandle; asm @@ -17589,7 +17980,7 @@ function MakeFontHandle( Self_: PGraphicTool ): THandle; var LF: TLogFont; {$ENDIF} begin - with Self_{-}^{+} do + with Self_^ do begin if fHandle = 0 then begin @@ -17612,16 +18003,13 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END MakeFontHandle] -//[FUNCTION MakePenHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function MakePenHandle( Self_: PGraphicTool ): THandle; var LogPen: TLogPen; begin - with Self_{-}^{+} do + with Self_^ do begin //GlobalGraphics_OnObjectCreating( @Self ); if fHandle = 0 then @@ -17640,17 +18028,12 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END MakePenHandle] -//+ - -//[function GetGeometricPen] function TGraphicTool.GetGeometricPen: Boolean; begin Result := fData.Pen.Geometric; // for BCB only end; -//[procedure TGraphicTool.SetGeometricPen] procedure TGraphicTool.SetGeometricPen(const Value: Boolean); begin if fData.Pen.Geometric = Value then Exit; @@ -17659,13 +18042,11 @@ begin Changed; end; -//[function TGraphicTool.GetPenEndCap] function TGraphicTool.GetPenEndCap: TPenEndCap; begin Result := fData.Pen.EndCap; // for BCB only end; -//[procedure TGraphicTool.SetPenEndCap] procedure TGraphicTool.SetPenEndCap(const Value: TPenEndCap); begin if fData.Pen.EndCap = Value then Exit; @@ -17673,13 +18054,11 @@ begin Changed; end; -//[function TGraphicTool.GetPenJoin] function TGraphicTool.GetPenJoin: TPenJoin; begin Result := fData.Pen.Join; // for BCB only end; -//[procedure TGraphicTool.SetPenJoin] procedure TGraphicTool.SetPenJoin(const Value: TPenJoin); begin if fData.Pen.Join = Value then Exit; @@ -17687,9 +18066,7 @@ begin Changed; end; -//[FUNCTION MakeGeometricPenHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function MakeGeometricPenHandle( Self_: PGraphicTool ): THandle; const PenStyles: array[ TPenStyle ] of Word = @@ -17703,7 +18080,7 @@ var LogBrush: TLogBrush; begin if Self_.fHandle = 0 then - with Self_{-}^{+}, LogBrush do + with Self_^, LogBrush do begin lbColor := Color2RGB( fData.Color ); lbHatch := 0; @@ -17741,16 +18118,13 @@ begin Result := Self_.fHandle; end; {$ENDIF ASM_VERSION} -//[END MakeGeometricPenHandle] {$ENDIF WIN_GDI} -//[function TGraphicTool.GetFontWeight] function TGraphicTool.GetFontWeight: Integer; begin Result := fData.Font.Weight; // for BCB only end; -//[procedure TGraphicTool.SetFontWeight] procedure TGraphicTool.SetFontWeight(const Value: Integer); begin if fData.Font.Weight = Value then Exit; @@ -17759,7 +18133,6 @@ begin end; {$IFDEF WIN_GDI} -//[procedure TGraphicTool.SetLogFontStruct] procedure TGraphicTool.SetLogFontStruct(const Value: TLogFont); begin if CompareMem(@fData.Font, @Value, SizeOf(TLogFont)) then Exit; @@ -17767,7 +18140,6 @@ begin Changed; end; -//[function TGraphicTool.GetLogFontStruct] function TGraphicTool.GetLogFontStruct: TLogFont; begin Move(fData.Font, Result, SizeOf(TLogFont)); @@ -17776,46 +18148,48 @@ end; {$IFDEF _X_} {$IFDEF GTK} -function TGraphicTool.GetPangoFontDesc: PPangoFontDescription; -var s: AnsiString; +FUNCTION TGraphicTool.GetPangoFontDesc: PPangoFontDescription; +VAR s: AnsiString; i: Integer; - function IfThen( cond: Boolean; const s: AnsiString ): AnsiString; - begin + FUNCTION IfThen( cond: Boolean; CONST s: AnsiString ): AnsiString; + BEGIN Result := ''; - if cond then Result := s; - end; + IF cond THEN Result := s; + END; {const Weights: array[0..9] of String = ( 'Ultralight', 'Ultralight', 'Ultralight', 'Light', 'Normal', 'Normal', 'Normal', 'Bold', 'Ultrabold', 'Heavy' );} -begin - if not Assigned( fPangoFontDesc ) then - begin - s := FontName; { + ' ' + - IfThen( FontWeight <> 400, Weights[ FontWeight div 100 ] + ' ' ) + - IfThen( fsItalic in FontStyle, 'Italic ' ) {+ - Int2Str( FontHeight )}; - fPangoFontDesc := pango_font_description_from_string( PAnsiChar( s ) ); - i := FontHeight; - if i > 0 then - pango_font_description_set_absolute_size( fPangoFontDesc, i * PANGO_SCALE ); - //i := pango_font_description_get_size( fPangoFontDesc ); - i := PANGO_STYLE_NORMAL; - if fsItalic in FontStyle then i := PANGO_STYLE_ITALIC; - pango_font_description_set_style( fPangoFontDesc, i ); - pango_font_description_set_weight( fPangoFontDesc, FontWeight ); - end; +BEGIN + ////////////////////////////////////// + IF NOT Assigned( fPangoFontDesc ) THEN + ////////////////////////////////////// + BEGIN + s := FontName; { + ' ' + + IfThen( FontWeight <> 400, Weights[ FontWeight div 100 ] + ' ' ) + + IfThen( fsItalic in FontStyle, 'Italic ' ) {+ + Int2Str( FontHeight )}; + fPangoFontDesc := pango_font_description_from_string( PAnsiChar( s ) ); + i := FontHeight; + IF i > 0 THEN + pango_font_description_set_absolute_size( fPangoFontDesc, i * PANGO_SCALE ); + //i := pango_font_description_get_size( fPangoFontDesc ); + i := PANGO_STYLE_NORMAL; + IF fsItalic IN FontStyle THEN i := PANGO_STYLE_ITALIC; + pango_font_description_set_style( fPangoFontDesc, i ); + pango_font_description_set_weight( fPangoFontDesc, FontWeight ); + END; Result := fPangoFontDesc; -end; +END; -function Color2GDKColor( Color: TColor ): TGdkColor; -begin +FUNCTION Color2GDKColor( Color: TColor ): TGdkColor; +BEGIN Color := Color2RGB( Color ); Result.pixel := 0; Result.red := (Color and $FF) shl 8; Result.green := Color and $FF00; Result.blue := (Color shr 8) and $FF00; -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} @@ -17832,7 +18206,6 @@ type var Stock: TStock; -//[destructor TCanvas.Destroy] destructor TCanvas.Destroy; begin Handle := 0; @@ -17842,9 +18215,7 @@ begin inherited; end; -//[function TCanvas.Assign] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TCanvas.Assign(SrcCanvas: PCanvas): Boolean; begin fFont := fFont.Assign( SrcCanvas.fFont ); @@ -17865,12 +18236,12 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.CreateBrush] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.CreateBrush; begin + ////////////////////////// if assigned( fBrush ) then + ////////////////////////// begin SelectObject( GetHandle, fBrush.Handle ); AssignChangeEvents; @@ -17888,7 +18259,9 @@ begin end; end else + ///////////////////////////////// if Assigned( fOwnerControl ) then + ///////////////////////////////// begin SetBkColor( GetHandle, Color2RGB( PControl( fOwnerControl ).fColor ) ); SetBkMode( fHandle, OPAQUE ); @@ -17896,47 +18269,42 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.CreateFont] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.CreateFont; begin - if assigned( fFont ) then + if ( fFont <> nil ) then begin - SelectObject( GetHandle, fFont.Handle ); - SetTextColor( fHandle, Color2RGB( fFont.fData.Color ) ); - AssignChangeEvents; + SelectObject( GetHandle, fFont.Handle ); + SetTextColor( fHandle, Color2RGB( fFont.fData.Color ) ); + AssignChangeEvents; end else - if Assigned( fOwnerControl ) then + if ( fOwnerControl <> nil ) then begin - SetTextColor( fHandle, Color2RGB( PControl( fOwnerControl ).fTextColor ) ); + SetTextColor( fHandle, + Color2RGB( PControl( fOwnerControl ).fTextColor ) ); end; end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.CreatePen] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.CreatePen; begin - if assigned( fPen ) then + if ( fPen <> nil ) then begin - SelectObject( GetHandle, fPen.Handle ); - SetROP2( fHandle, Ord( fPen.fData.Pen.Mode ) + 1 ); - AssignChangeEvents; + SelectObject( GetHandle, fPen.Handle ); + SetROP2( fHandle, Ord( fPen.fData.Pen.Mode ) + 1 ); + AssignChangeEvents; end; end; {$ENDIF ASM_VERSION} -//[function TCanvas.GetPixels] function TCanvas.GetPixels(X, Y: Integer): TColor; begin RequiredState( HandleValid ); Result := Windows.GetPixel(FHandle, X, Y); end; -//[procedure TCanvas.SetPixels] procedure TCanvas.SetPixels(X, Y: Integer; const Value: TColor); begin Changing; @@ -17963,70 +18331,61 @@ end; {$IFDEF _X_} {$IFDEF GTK} -procedure TCanvas.SaveState; -begin +PROCEDURE TCanvas.SaveState; +BEGIN gdk_gc_get_values( fHandle, @ fSavedState ); -end; +END; -procedure TCanvas.RestoreState; -var mask: DWORD; -begin +PROCEDURE TCanvas.RestoreState; +VAR mask: DWORD; +BEGIN mask := $1FFFF; if fSavedState.font = nil then mask := mask and not GDK_GC_FONT; if fSavedState.stipple = nil then mask := mask and not GDK_GC_STIPPLE; gdk_gc_set_values( fHandle, @ fSavedState, mask ); DeselectHandles; -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[procedure TCanvas.DeselectHandles] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.DeselectHandles; begin - if (fHandle <> 0) and - LongBool(fState and (PenValid or BrushValid or FontValid)) then + if (fHandle <> 0) and + LongBool(fState and (PenValid or BrushValid or FontValid)) then with Stock do begin - if StockPen = 0 then - begin - StockPen := GetStockObject(BLACK_PEN); - StockBrush := GetStockObject(HOLLOW_BRUSH); - StockFont := GetStockObject(SYSTEM_FONT); - end; - SelectObject( fHandle, StockPen ); - SelectObject( fHandle, StockBrush ); - SelectObject( fHandle, StockFont ); - fState := fState and not( PenValid or BrushValid or FontValid ); + if StockPen = 0 then + begin + StockPen := GetStockObject(BLACK_PEN); + StockBrush := GetStockObject(HOLLOW_BRUSH); + StockFont := GetStockObject(SYSTEM_FONT); + end; + SelectObject( fHandle, StockPen ); + SelectObject( fHandle, StockBrush ); + SelectObject( fHandle, StockFont ); + fState := fState and not( PenValid or BrushValid or FontValid ); end; end; {$ENDIF ASM_VERSION} {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TCanvas.DeselectHandles; -begin - {$IFDEF GDI} - Free_And_Nil( fBrush ); - Free_And_Nil( fPen ); - Free_And_Nil( fFont ); - {$ENDIF GDI} - if Assigned( fFont ) and Assigned( fFont.fPangoFontDesc ) then - begin - pango_font_description_free( fFont.fPangoFontDesc ); - fFont.fPangoFontDesc := nil; - end; +PROCEDURE TCanvas.DeselectHandles; +BEGIN + IF ( fFont <> nil ) AND ( fFont.fPangoFontDesc <> nil ) THEN + BEGIN + pango_font_description_free( fFont.fPangoFontDesc ); + fFont.fPangoFontDesc := nil; + END; fState := fState and not( PenValid or BrushValid or FontValid ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -//[function TCanvas.RequiredState] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TCanvas.RequiredState(ReqState: DWORD): HDC; stdcall; var NeededState: Byte; @@ -18047,8 +18406,8 @@ begin if Boolean( NeededState and PenValid ) then begin CreatePen; - if assigned( fPen ) then - if fPen.fData.Pen.Style in [psDash, psDot, psDashDot, psDashDotDot] then + if ( fPen <> nil ) then + if fPen.fData.Pen.Style in [psDash, psDot, psDashDot, psDashDotDot] then NeededState := NeededState or BrushValid; end; if Boolean( NeededState and BrushValid ) then @@ -18062,21 +18421,19 @@ end; {$IFDEF _X_} {$IFDEF GTK} -procedure TCanvas.ForeBack(fg_color, bk_color: TColor); // install colors just before drawing -begin +PROCEDURE TCanvas.ForeBack(fg_color, bk_color: TColor); // install colors just before drawing +BEGIN fg_color := RGB2BGR( Color2RGB( fg_color ) ); bk_color := RGB2BGR( Color2RGB( bk_color ) ); gdk_rgb_gc_set_foreground( fHandle, fg_color ); gdk_rgb_gc_set_background( fHandle, bk_color ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -//[procedure TCanvas.SetHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.SetHandle(Value: HDC); {$IFDEF F_P} var Ptr1: Pointer; @@ -18087,7 +18444,7 @@ begin begin DeselectHandles; {$IFDEF GDI} - if not( assigned(fOwnerControl) and + if not( (fOwnerControl <> nil) and (PControl(fOwnerControl).fPaintDC = fHandle) ) then begin {$IFDEF F_P} @@ -18123,9 +18480,7 @@ end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[procedure TCanvas.SetPenPos] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.SetPenPos(const Value: TPoint); begin fPenPos := Value; @@ -18136,21 +18491,19 @@ end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[procedure TCanvas.Changing] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.Changing; begin - if Assigned( fOnChange ) then - fOnChange( @Self ); + ////////////////////////////// + if Assigned( fOnChange ) then + ////////////////////////////// + fOnChange( @Self ); end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[procedure TCanvas.Arc] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall; begin RequiredState( HandleValid or PenValid or ChangingCanvas ); @@ -18160,11 +18513,11 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall; -var C: TPoint; +PROCEDURE TCanvas.Arc(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); STDCALL; +VAR C: TPoint; angle1, angle2: Integer; A1, A2: Double; -begin +BEGIN ////RequiredState( {HandleValid or} PenValid or ChangingCanvas ); C := MakePoint( (X1 + X2) div 2, (Y1 + Y2) div 2 ); {$IFDEF NOT_USE_EXCEPTION} @@ -18184,21 +18537,19 @@ begin {$ENDIF NOT_USE_EXCEPTION} angle1 := -Round(A1 * 180 * 64 / PI); angle2 := -Round(A2 * 180 * 64 / PI); - if Brush.BrushStyle <> bsClear then - begin - ForeBack( Brush.Color, Brush.Color ); - gdk_draw_arc( fDrawable, fHandle, 1, X1, Y1, X2-X1, Y2-Y1, angle1, angle2 ); - end; + IF Brush.BrushStyle <> bsClear THEN + BEGIN + ForeBack( Brush.Color, Brush.Color ); + gdk_draw_arc( fDrawable, fHandle, 1, X1, Y1, X2-X1, Y2-Y1, angle1, angle2 ); + END; ForeBack( Pen.Color, Brush.Color ); gdk_draw_arc( fDrawable, fHandle, 0, X1, Y1, X2-X1, Y2-Y1, angle1, angle2 ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -//[procedure TCanvas.Chord] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.Chord(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall; begin RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas ); @@ -18206,9 +18557,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.CopyRect] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.CopyRect(const DstRect: TRect; SrcCanvas: PCanvas; const SrcRect: TRect); begin @@ -18220,9 +18569,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.DrawFocusRect] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.DrawFocusRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect); begin RequiredState( HandleValid or BrushValid or FontValid or ChangingCanvas ); @@ -18230,9 +18577,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.Ellipse] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.Ellipse(X1, Y1, X2, Y2: Integer); begin RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas ); @@ -18241,23 +18586,21 @@ end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[procedure TCanvas.FillRect] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.FillRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect); var Br: HBrush; begin RequiredState( HandleValid or BrushValid or ChangingCanvas ); - if assigned( fBrush ) then + if ( fBrush <> nil ) then begin Windows.FillRect(fHandle, Rect, fBrush.Handle); end else - if assigned( fOwnerControl ) then + if ( fOwnerControl <> nil ) then begin {$IFDEF GDI} - if assigned( PControl( fOwnerControl ).fBrush ) then + if ( PControl( fOwnerControl ).fBrush <> nil ) then Windows.FillRect( fHandle, Rect, PControl( fOwnerControl ).fBrush.Handle ) else begin @@ -18276,38 +18619,36 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TCanvas.FillRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect); -begin +PROCEDURE TCanvas.FillRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect); +BEGIN if (fBrush <> nil) and (fBrush.BrushStyle = bsClear) then Exit; ////RequiredState( {HandleValid or} BrushValid or ChangingCanvas ); ForeBack( Brush.Color, Brush.Color ); gdk_draw_rectangle( fDrawable, fHandle, 1, Rect.Left, Rect.Top, Rect.Right-Rect.Left, Rect.Bottom-Rect.Top ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -//[procedure TCanvas.FillRgn] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.FillRgn(const Rgn: HRgn); var Br : HBrush; begin RequiredState( HandleValid or BrushValid or ChangingCanvas ); - if assigned( fBrush ) then + if ( fBrush <> nil ) then Windows.FillRgn(FHandle, Rgn, fBrush.Handle ) else - if assigned( fOwnerControl ) then + if ( fOwnerControl <> nil ) then begin {$IFDEF GDI} - if Assigned( PControl( fOwnerControl ).fBrush ) then - Windows.FillRgn( FHandle, Rgn, PControl( fOwnerControl ).fBrush.Handle ) + if ( PControl( fOwnerControl ).fBrush <> nil ) then + Windows.FillRgn( FHandle, Rgn, PControl( fOwnerControl ).fBrush.Handle ) else begin - Br := CreateSolidBrush( Color2RGB(PControl(fOwnerControl).fColor) ); - Windows.FillRgn( fHandle, Rgn, Br ); - DeleteObject( Br ); + Br := CreateSolidBrush( Color2RGB(PControl(fOwnerControl).fColor) ); + Windows.FillRgn( fHandle, Rgn, Br ); + DeleteObject( Br ); end; {$ENDIF GDI} end @@ -18320,9 +18661,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.FloodFill] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle); const @@ -18334,17 +18673,15 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.FrameRect] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.FrameRect({$IFNDEF FPC}const{$ENDIF} Rect: TRect); var SolidBr : HBrush; begin RequiredState( HandleValid or ChangingCanvas ); - if assigned( fBrush ) then + if ( fBrush <> nil ) then SolidBr := CreateSolidBrush( Color2RGB( fBrush.fData.Color ) ) else - if assigned( fOwnerControl ) then + if ( fOwnerControl <> nil ) then SolidBr := CreateSolidBrush( PControl(fOwnerControl).fColor ) else SolidBr := CreateSolidBrush( clWhite ); @@ -18354,10 +18691,8 @@ end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[procedure TCanvas.LineTo] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.LineTo(X, Y: Integer); begin RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas ); @@ -18367,21 +18702,17 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TCanvas.LineTo(X, Y: Integer); -begin - //RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas ); - ////RequiredState( PenValid or BrushValid or ChangingCanvas ); +PROCEDURE TCanvas.LineTo(X, Y: Integer); +BEGIN ForeBack( Pen.Color, Brush.Color ); gdk_draw_line( fDrawable, fHandle, fPenPos.X, fPenPos.Y, X, Y ); fPenPos := MakePoint( X, Y ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[procedure TCanvas.MoveTo] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.MoveTo(X, Y: Integer); begin RequiredState( HandleValid ); @@ -18391,23 +18722,20 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TCanvas.MoveTo(X, Y: Integer); -begin +PROCEDURE TCanvas.MoveTo(X, Y: Integer); +BEGIN fPenPos := MakePoint( X, Y ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[procedure TCanvas.ObjectChanged] procedure TCanvas.ObjectChanged(Sender: PGraphicTool); begin DeselectHandles; end; {$IFDEF WIN_GDI} -//[procedure TCanvas.Pie] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.Pie(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer); stdcall; begin RequiredState( HandleValid or PenValid or BrushValid or ChangingCanvas ); @@ -18415,30 +18743,7 @@ begin end; {$ENDIF ASM_VERSION} -{++}(* -{$IFDEF F_P} -//[Windows API FUNCTIONS ADDITIONAL DECLARATIONS FOR Free Pascal] -function Windows_Polygon; external gdi32 name 'Polygon'; -function Windows_Polyline; external gdi32 name 'Polyline'; -function FillRect; external user32 name 'FillRect'; -function OffsetRect; external user32 name 'OffsetRect'; -function CreateAcceleratorTable; external user32 name 'CreateAcceleratorTableA'; -function TrackPopupMenu; external user32 name 'TrackPopupMenu'; -function AdjustTokenPrivileges(TokenHandle: THandle; DisableAllPrivileges: BOOL; - const NewState: TTokenPrivileges; BufferLength: DWORD; - var PreviousState: TTokenPrivileges; var ReturnLength: DWORD): BOOL; external advapi32 name 'AdjustTokenPrivileges'; -function InflateRect; external user32 name 'InflateRect'; -{$IFDEF F_P105ORBELOW} -function InvalidateRect; external user32 name 'InvalidateRect'; -function ValidateRect; external user32 name 'ValidateRect'; -{$ENDIF F_P105ORBELOW} -//[END OF Windows API FUNCTIONS ADDITIONAL DECLARATIONS FOR Free Pascal] -{$ENDIF} -*){--} - -//[procedure TCanvas.Polygon] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.Polygon(const Points: array of TPoint); type PPoints = ^TPoints; @@ -18451,9 +18756,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.Polyline] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.Polyline(const Points: array of TPoint); type PPoints = ^TPoints; @@ -18466,9 +18769,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.Rectangle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.Rectangle(X1, Y1, X2, Y2: Integer); begin RequiredState( HandleValid or BrushValid or PenValid or ChangingCanvas ); @@ -18476,9 +18777,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TCanvas.RoundRect] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer); begin RequiredState( HandleValid or BrushValid or PenValid or ChangingCanvas ); @@ -18487,16 +18786,13 @@ end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[procedure TCanvas.TextArea] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal -procedure TCanvas.TextArea(const Text: AnsiString; var Sz: TSize; +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal +procedure TCanvas.TextArea(const Text: KOLString; var Sz: TSize; var P0: TPoint); begin Sz := TextExtent( Text ); P0.x := 0; P0.y := 0; - if Assigned( GlobalCanvas_OnTextArea ) then - GlobalCanvas_OnTextArea( @Self, Sz, P0 ); + TOnTextArea( GlobalCanvas_OnTextArea )( @Self, Sz, P0 ); end; {$ENDIF ASM_VERSION} @@ -18506,15 +18802,12 @@ procedure TCanvas.WTextArea(const Text: WideString; var Sz: TSize; begin Sz := WTextExtent( Text ); P0.x := 0; P0.y := 0; - if Assigned( GlobalCanvas_OnTextArea ) then - GlobalCanvas_OnTextArea( @Self, Sz, P0 ); + TOnTextArea( GlobalCanvas_OnTextArea )( @Self, Sz, P0 ); end; {$ENDIF _D3orHigher} -//[function TCanvas.TextExtent] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TCanvas.TextExtent(const Text: AnsiString): TSize; var DC : HDC; ClearHandle : Boolean; @@ -18542,39 +18835,36 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function TCanvas.TextExtent(const Text: Ansistring): TSize; -var layout: PPangoLayout; +FUNCTION TCanvas.TextExtent(const Text: Ansistring): TSize; +VAR layout: PPangoLayout; context: PPangoContext; -begin +BEGIN //RequiredState( HandleValid or FontValid ); - if fOwnerControl <> nil then - begin - context := nil; - layout := gtk_widget_create_pango_layout( - PControl( fOwnerControl ).fEventboxHandle, nil ); - end - else - begin //todo: seems not working in such way... What to do for memory bitmap? + IF fOwnerControl <> nil THEN + BEGIN + context := nil; + layout := gtk_widget_create_pango_layout( + PControl( fOwnerControl ).fEventboxHandle, nil ); + END ELSE + BEGIN //todo: seems not working in such way... What to do for memory bitmap? context := pango_context_new; //layout := gtk_widget_create_pango_layout( fHandle, PChar( Text ) ); layout := pango_layout_new( context ); - end; + END; pango_layout_set_font_description( layout, Font.FontHandle ); pango_layout_set_text( layout, PAnsiChar( Text ), Length( Text ) ); pango_layout_get_size( layout, @ Result.cx, @ Result.cy ); g_object_unref( layout ); - if context <> nil then g_object_unref( context ); -end; + IF context <> nil THEN g_object_unref( context ); +END; {$ENDIF GTK} {$ENDIF _X_} -//[function TCanvas.TextHeight] function TCanvas.TextHeight(const Text: Ansistring): Integer; begin Result := TextExtent(Text).cY; end; -//[procedure TCanvas.TextOut] {$IFDEF GDI} procedure TCanvas.TextOutA(X, Y: Integer; const Text: AnsiString); stdcall; begin @@ -18618,20 +18908,18 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TCanvas.TextOut(X, Y: Integer; const Text: AnsiString); stdcall; -var Options: Integer; -begin +PROCEDURE TCanvas.TextOut(X, Y: Integer; CONST Text: AnsiString); STDCALL; +VAR Options: Integer; +BEGIN Options := 0; if Brush.BrushStyle <> bsClear then Options := ETO_OPAQUE; ExtTextOut( X, Y, Options, MakeRect( 0,0,0,0 ), Text, [ ] ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[procedure TCanvas.TextRect] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.TextRect(const Rect: TRect; X, Y: Integer; const Text: Ansistring); var Options: Integer; @@ -18639,8 +18927,8 @@ begin //Changing; RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas ); Options := ETO_CLIPPED; - if assigned( fBrush ) and (fBrush.fData.Brush.Style <> bsClear) - or not assigned( fBrush ) then Inc(Options, ETO_OPAQUE); + if ( fBrush <> nil ) and (fBrush.fData.Brush.Style <> bsClear) + or ( fBrush = nil ) then Inc(Options, ETO_OPAQUE); Windows.ExtTextOutA( fHandle, X, Y, Options, @Rect, PAnsiChar(Text), Length(Text), nil); // KOL_ANSI @@ -18649,17 +18937,16 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TCanvas.TextRect(const Rect: TRect; X, Y: Integer; const Text: Ansistring); -var Options: Integer; -begin - Options := ETO_CLIPPED; - if Brush.BrushStyle <> bsClear then Options := Options or ETO_OPAQUE; - ExtTextOut( X, Y, Options, Rect, Text, [] ); // KOL_ANSI -end; +PROCEDURE TCanvas.TextRect(CONST Rect: TRect; X, Y: Integer; CONST Text: Ansistring); +VAR Options: Integer; +BEGIN + Options := ETO_CLIPPED; + IF Brush.BrushStyle <> bsClear THEN Options := Options or ETO_OPAQUE; + ExtTextOut( X, Y, Options, Rect, Text, [] ); // KOL_ANSI +END; {$ENDIF GTK} {$ENDIF _X_} -//[procedure TCanvas.ExtTextOut] {$IFDEF GDI} procedure TCanvas.ExtTextOut( X, Y: Integer; Options: DWORD; const Rect: TRect; const Text: AnsiString; const Spacing: array of Integer ); @@ -18670,69 +18957,65 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TCanvas.ExtTextOut( X, Y: Integer; Options: DWORD; const Rect: TRect; const Text: AnsiString; - const Spacing: array of Integer ); -var context: PPangoContext; +PROCEDURE TCanvas.ExtTextOut( X, Y: Integer; Options: DWORD; CONST Rect: TRect; + CONST Text: AnsiString; CONST Spacing: ARRAY of Integer ); +VAR context: PPangoContext; layout: PPangoLayout; w, h: Integer; pixmap: PGdkPixmap; -begin +BEGIN ////RequiredState( {HandleValid or} FontValid or BrushValid or ChangingCanvas ); w := Rect.Right - Rect.Left; h := Rect.Bottom - Rect.Top; - if fOwnerControl <> nil then - begin - context := nil; - layout := gtk_widget_create_pango_layout( - PControl( fOwnerControl ).fEventboxHandle, nil ); - end - else - begin //todo: seems not working in such way... What to do for memory bitmap? - context := pango_context_new; - //layout := gtk_widget_create_pango_layout( fHandle, PChar( Text ) ); - layout := pango_layout_new( context ); - end; + IF fOwnerControl <> nil THEN + BEGIN + context := nil; + layout := gtk_widget_create_pango_layout( + PControl( fOwnerControl ).fEventboxHandle, nil ); + END ELSE + BEGIN //todo: seems not working in such way... What to do for memory bitmap? + context := pango_context_new; + //layout := gtk_widget_create_pango_layout( fHandle, PChar( Text ) ); + layout := pango_layout_new( context ); + END; pango_layout_set_font_description( layout, Font.FontHandle ); pango_layout_set_text( layout, PAnsiChar( Text ), Length( Text ) ); - if Options and ETO_CLIPPED = 0 then - begin + IF Options AND ETO_CLIPPED = 0 THEN + BEGIN pango_layout_get_size( layout, @ w, @ h ); w := w div PANGO_SCALE; h := h div PANGO_SCALE; - end; + END; pixmap := gdk_pixmap_new( PControl( fOwnerControl ).fEventboxHandle.window, w, h, -1 ); //todo: use MainForm - if Options and ETO_OPAQUE <> 0 then - begin - ForeBack( Brush.Color, Brush.Color ); - gdk_draw_rectangle( GDK_DRAWABLE( pixmap ), fHandle, 1, 0, 0, w, h ); - end - else - begin - gdk_draw_drawable( GDK_DRAWABLE( pixmap ), fHandle, fDrawable, - Rect.Left, Rect.Top, 0, 0, w, h ); - end; + IF Options AND ETO_OPAQUE <> 0 THEN + BEGIN + ForeBack( Brush.Color, Brush.Color ); + gdk_draw_rectangle( GDK_DRAWABLE( pixmap ), fHandle, 1, 0, 0, w, h ); + END ELSE + BEGIN + gdk_draw_drawable( GDK_DRAWABLE( pixmap ), fHandle, fDrawable, + Rect.Left, Rect.Top, 0, 0, w, h ); + END; ForeBack( Font.Color, Brush.Color ); gdk_draw_layout( GDK_DRAWABLE( pixmap ), fHandle, X, Y, layout ); g_object_unref( layout ); gdk_draw_drawable( fDrawable, fHandle, GDK_DRAWABLE( pixmap ), 0, 0, Rect.Left, Rect.Top, w, h ); g_object_unref( pixmap ); - if context <> nil then - g_object_unref( context ); -end; + IF context <> nil THEN + g_object_unref( context ); +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -//[procedure TCanvas.DrawText] procedure TCanvas.DrawText(Text: AnsiString; var Rect:TRect; Flags:DWord); begin RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas ); Windows.DrawTextA(Handle, PAnsiChar(Text), Length(Text), Rect, Flags); // KOL_ANSI end; -//[function TCanvas.ClipRect] function TCanvas.ClipRect: TRect; begin RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas ); @@ -18740,29 +19023,25 @@ begin end; {$ENDIF WIN_GDI} -//[function TCanvas.TextWidth] function TCanvas.TextWidth(const Text: Ansistring): Integer; begin Result := TextExtent(Text).cX; end; -//[function TCanvas.GetBrush] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TCanvas.GetBrush: PGraphicTool; begin - if not assigned( fBrush ) then + if ( fBrush = nil ) then begin fBrush := NewBrush; - if assigned( fOwnerControl ) then + if ( fOwnerControl <> nil ) then begin fBrush.fData.Color := PControl(fOwnerControl).fColor; - if assigned( PControl(fOwnerControl).fBrush ) then - {fBrush := }fBrush.Assign( PControl(fOwnerControl).fBrush ); + if ( PControl(fOwnerControl).fBrush <> nil ) then + fBrush.Assign( PControl(fOwnerControl).fBrush ); // both statements above needed end; - //fBrush.OnChange := ObjectChanged; AssignChangeEvents; end; Result := fBrush; @@ -18771,53 +19050,47 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function TCanvas.GetBrush: PGraphicTool; -begin - if not assigned( fBrush ) then - begin - fBrush := NewBrush; - if assigned( fOwnerControl ) then - begin - fBrush.fData.Color := PControl(fOwnerControl).fColor; - if assigned( PControl(fOwnerControl).fBrush ) then - {fBrush := }fBrush.Assign( PControl(fOwnerControl).fBrush ); - // both statements above needed - end; - //fBrush.OnChange := ObjectChanged; - AssignChangeEvents; - end; +FUNCTION TCanvas.GetBrush: PGraphicTool; +BEGIN + IF ( fBrush = nil ) THEN + BEGIN + fBrush := NewBrush; + IF ( fOwnerControl <> nil ) THEN + BEGIN + fBrush.fData.Color := PControl(fOwnerControl).fColor; + IF ( PControl(fOwnerControl).fBrush <> nil ) THEN + fBrush.Assign( PControl(fOwnerControl).fBrush ); + // both statements above needed + END; + AssignChangeEvents; + END; Result := fBrush; -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[function TCanvas.GetFont] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TCanvas.GetFont: PGraphicTool; begin - if not assigned( fFont ) then + if ( fFont = nil ) then begin fFont := NewFont; - if assigned( fOwnerControl ) then + if ( fOwnerControl <> nil ) then begin fFont.Color := PControl(fOwnerControl).fTextColor; - if assigned( PControl(fOwnerControl).fFont ) then - {fFont := }fFont.Assign( PControl(fOwnerControl).fFont ); + if ( PControl(fOwnerControl).fFont <> nil ) then + fFont.Assign( PControl(fOwnerControl).fFont ); end; - //fFont.OnChange := ObjectChanged; AssignChangeEvents; end; Result := fFont; end; {$ENDIF ASM_VERSION} -//[function TCanvas.GetPen] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TCanvas.GetPen: PGraphicTool; begin - if not assigned( fPen ) then + if ( fPen = nil ) then begin fPen := NewPen; AssignChangeEvents; @@ -18826,44 +19099,43 @@ begin end; {$ENDIF ASM_VERSION} -//[function TCanvas.GetHandle] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TCanvas.GetHandle: HDC; begin - if assigned( fOnGetHandle ) then + ///////////////////////////////// + if Assigned( fOnGetHandle ) then + ///////////////////////////////// begin - Result := fOnGetHandle( @Self ); - //fHandle := Result; - SetHandle( Result ); + Result := fOnGetHandle( @Self ); + SetHandle( Result ); end else - Result := fHandle; + Result := fHandle; end; {$ENDIF ASM_VERSION} {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function TCanvas.GetHandle: HDC; -begin - if Assigned( fOnGetHandle ) then - fHandle := fOnGetHandle( @Self ); +FUNCTION TCanvas.GetHandle: HDC; +BEGIN + //////////////////////////////// + IF Assigned( fOnGetHandle ) THEN + //////////////////////////////// + fHandle := fOnGetHandle( @Self ); Result := fHandle; -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[procedure TCanvas.AssignChangeEvents] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TCanvas.AssignChangeEvents; begin - if assigned( fBrush ) then + if ( fBrush <> nil ) then fBrush.fOnChange := ObjectChanged; - if assigned( fPen ) then + if ( fPen <> nil ) then fPen.fOnChange := ObjectChanged; - if assigned( fFont ) then + if ( fFont <> nil ) then fFont.fOnChange := ObjectChanged; end; {$ENDIF ASM_VERSION} @@ -18871,7 +19143,6 @@ end; {$IFNDEF _FPC} {$IFNDEF _D2} -//[procedure TCanvas.WDrawText] procedure TCanvas.WDrawText(WText: WideString; var Rect: TRect; Flags: DWord); begin @@ -18879,7 +19150,6 @@ begin Windows.DrawTextW(Handle,PWideChar(WText),Length(WText),Rect,Flags); end; -//[procedure TCanvas.WExtTextOut] procedure TCanvas.WExtTextOut(X, Y: Integer; Options: DWORD; const Rect: TRect; const WText: WideString; const Spacing: array of Integer); @@ -18888,7 +19158,6 @@ begin Windows.ExtTextOutW(FHandle, X, Y, Options, @Rect, PWideChar(WText), Length(WText), @Spacing[ 0 ]); end; -//[procedure TCanvas.WTextOut] procedure TCanvas.WTextOut(X, Y: Integer; const WText: WideString); begin RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas ); @@ -18896,7 +19165,6 @@ begin MoveTo(X + WTextWidth(WText), Y); end; -//[procedure TCanvas.WTextRect] procedure TCanvas.WTextRect(const Rect: TRect; X, Y: Integer; const WText: WideString); var @@ -18905,14 +19173,13 @@ begin //Changing; RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas ); Options := ETO_CLIPPED; - if assigned( fBrush ) and (fBrush.fData.Brush.Style <> bsClear) - or not assigned( fBrush ) then Inc(Options, ETO_OPAQUE); + if ( fBrush <> nil ) and (fBrush.fData.Brush.Style <> bsClear) + or ( fBrush = nil ) then Inc(Options, ETO_OPAQUE); Windows.ExtTextOutW( fHandle, X, Y, Options, @Rect, PWideChar(WText), Length(WText), nil); end; -//[function TCanvas.WTextExtent] function TCanvas.WTextExtent(const WText: WideString): TSize; var DC : HDC; ClearHandle : Boolean; @@ -18932,13 +19199,11 @@ begin SetHandle( 0 ); end; -//[function TCanvas.WTextHeight] function TCanvas.WTextHeight(const WText: WideString): Integer; begin Result := WTextExtent( WText ).cy; end; -//[function TCanvas.WTextWidth] function TCanvas.WTextWidth(const WText: WideString): Integer; begin Result := WTextExtent( WText ).cx; @@ -18947,15 +19212,12 @@ end; {$ENDIF _FPC} {$ENDIF WIN_GDI} -{-} -//[function MakeInt64] function MakeInt64( Lo, Hi: DWORD ): I64; begin Result.Lo := Lo; Result.Hi := Hi; end; -//[function Int2Int64] function Int2Int64( X: Integer ): I64; asm MOV [EDX], EAX @@ -18964,21 +19226,18 @@ asm MOV [ECX+4], EDX end; -//[procedure IncInt64] procedure IncInt64( var I64: I64; Delta: Integer ); asm ADD [EAX], EDX ADC dword ptr [EAX+4], 0 end; -//[procedure DecInt64] procedure DecInt64( var I64: I64; Delta: Integer ); asm SUB [EAX], EDX SBB dword ptr [EDX], 0 end; -//[function Add64] function Add64( const X, Y: I64 ): I64; asm PUSH ESI @@ -18992,7 +19251,6 @@ asm POP ESI end; -//[function Sub64] function Sub64( const X, Y: I64 ): I64; asm PUSH ESI @@ -19006,7 +19264,6 @@ asm POP ESI end; -//[function Neg64] function Neg64( const X: I64 ): I64; asm MOV ECX, [EAX] @@ -19017,7 +19274,6 @@ asm MOV [EDX+4], ECX end; -//[function Mul64EDX] function Mul64EDX( const X: I64; M: Integer ): I64; asm PUSH ESI @@ -19037,9 +19293,7 @@ asm POP ESI end; -//[FUNCTION Mul64i] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function Mul64i( const X: I64; Mul: Integer ): I64; var Minus: Boolean; begin @@ -19054,9 +19308,7 @@ begin Result := Neg64( Result ); end; {$ENDIF ASM_VERSION} -//[END Mul64i] -//[function Div64EDX] function Div64EDX( const X: I64; D: Integer ): I64; asm PUSH ESI @@ -19075,9 +19327,7 @@ asm POP ESI end; -//[FUNCTION Div64i] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function Div64i( const X: I64; D: Integer ): I64; var Minus: Boolean; begin @@ -19098,15 +19348,12 @@ begin Result := Neg64( Result ); end; {$ENDIF ASM_VERSION} -//[END Div64i] -//[function Mod64i] function Mod64i( const X: I64; D: Integer ): Integer; begin Result := Sub64( X, Mul64i( Div64i( X, D ), D ) ).Lo; end; -//[function Sgn64] function Sgn64( const X: I64 ): Integer; asm XOR EDX, EDX @@ -19124,13 +19371,11 @@ asm @@exit: end; -//[function Cmp64] function Cmp64( const X, Y: I64 ): Integer; begin Result := Sgn64( Sub64( X, Y ) ); end; -//[function Int64_2Str] function Int64_2Str( X: I64 ): AnsiString; var M: Boolean; Y: Integer; @@ -19169,7 +19414,6 @@ begin Result := Int2Hex( X.Lo, MinDigits ); end; -//[function Str2Int64] function Str2Int64( const S: AnsiString ): I64; var I: Integer; M: Boolean; @@ -19199,30 +19443,25 @@ begin Result := Neg64( Result ); end; -//[function Int64_2Double] function Int64_2Double( const X: I64 ): Double; asm FILD qword ptr [EAX] FSTP @Result end; -//[function Double2Int64] function Double2Int64( D: Double ): I64; asm FLD D FISTP qword ptr [EAX] end; -{+} function IsNan(const AValue: Double): Boolean; {$IFDEF _D2orD3} type PI64 = ^I64; {$ENDIF} begin - {-} Result := (PI64(@AValue).Hi and $7FF00000 = $7FF00000) and ((PI64(@AValue).Hi and $000FFFFF <> 0) or (PI64(@AValue).Lo <> 0)); - {+}{++}(*Result := AValue = NAN;*){--} end; function IsInfinity(const AValue: Double): Boolean; @@ -19230,31 +19469,13 @@ function IsInfinity(const AValue: Double): Boolean; type PI64 = ^I64; {$ENDIF} begin - {-} Result := (PI64(@AValue).Hi and $7FF00000 = $7FF00000) and (PI64(@AValue).Hi and $000FFFFF = $00000000); - {+}{++}(*Result := AValue = Infinite;*){--} end; -//[function IntPower] function IntPower(Base: Extended; Exponent: Integer): Extended; {$IFDEF F_P} begin - {if Exponent = 0 then - begin - Result := 1.0; - Exit; - end; - if Exponent < 0 then - begin - Exponent := -Exponent; - Base := 1.0 / Base; - end; - Result := Base; - REPEAT - Result := Result * Base; - Dec( Exponent ); - UNTIL Exponent <= 0;} Result := 1.0; if Exponent = 0 then exit; if Exponent < 0 then begin @@ -19297,8 +19518,7 @@ begin Result := Result shl 1; end; -//[function Str2Double] -function Str2Double( const S: AnsiString ): Double; +function Str2Double( const S: KOLString ): Double; var I: Integer; M, Pt: Boolean; D: Double; @@ -19338,7 +19558,7 @@ begin Result := -Result; end; -function Str2Extended( const S: AnsiString ): Extended; +function Str2Extended( const S: KOLString ): Extended; var I: Integer; M, Pt: Boolean; D: Extended; @@ -19378,9 +19598,7 @@ begin Result := -Result; end; -//[function TruncD] function TruncD( D: Double ): Double; -{-} asm FLD D PUSH ECX @@ -19396,11 +19614,6 @@ asm POP ECX POP ECX end; -{+}{++}(* -begin - Result := Trunc( D ); -end; -*){--} function IfThenElseBool( t, e: Boolean; Cond: Boolean ): Boolean; begin @@ -19434,9 +19647,8 @@ end; {$ENDIF} // Precision 15 -//[function Extended2Str] -function Extended2Str( E: Extended ): AnsiString; - function UnpackFromBuf( const Buf: array of Byte; N: Integer ): AnsiString; +function Extended2Str( E: Extended ): KOLString; + function UnpackFromBuf( const Buf: array of Byte; N: Integer ): KOLString; var I, J, K, L: Integer; begin SetLength( Result, 16 ); @@ -19444,10 +19656,10 @@ function Extended2Str( E: Extended ): AnsiString; for I := 7 downto 0 do begin K := Buf[ I ] shr 4; - Result[ J ] := AnsiChar( Ord('0') + K ); + Result[ J ] := KOLChar( Ord('0') + K ); Inc( J ); K := Buf[ I ] and $F; - Result[ J ] := AnsiChar( Ord('0') + K ); + Result[ J ] := KOLChar( Ord('0') + K ); Inc( J ); end; @@ -19480,7 +19692,9 @@ function Extended2Str( E: Extended ): AnsiString; L := Length( Result ); while L > 1 do begin - if not (Result[ L ] in ['0','.']) then break; + if (Result[ L ] <> '0') + and (Result[ L ] <> '.') then + break; Dec( L ); if Result[ L + 1 ] = '.' then break; end; @@ -19531,13 +19745,13 @@ begin if S then Result := '-' + Result; end; -function Extended2StrDigits( D: Double; n: Integer ): AnsiString; +function Extended2StrDigits( D: Double; n: Integer ): KOLString; var i, m: Integer; label start; begin start: Result := Extended2Str( D ); - i := pos( '.', Result ); + i := IndexOfChar( Result, '.' ); //pos( '.', Result ); if n <= 0 then begin if i <= 0 then Exit; @@ -19582,13 +19796,11 @@ start: end; end; -//[function Double2Str] -function Double2Str( D: Double ): AnsiString; +function Double2Str( D: Double ): KOLString; begin Result := Extended2Str( D ); end; -//[function Double2StrEx] function Double2StrEx( D: Double ): AnsiString; var E, E1, E2: Double; S: AnsiString; @@ -19612,7 +19824,6 @@ begin end; end; -//[function GetBits] function GetBits( N: DWORD; first, last: Byte ): DWord; {$IFDEF F_P} begin @@ -19650,7 +19861,6 @@ asm end; {$ENDIF F_P/DELPHI} -//[function GetBitsL] function GetBitsL( N: DWORD; from, len: Byte ): DWord; {$IFDEF F_P} begin @@ -19664,7 +19874,6 @@ asm end; {$ENDIF F_P/DELPHI} -//[FUNCTION MulDiv] {$IFNDEF FPC} function MulDiv( A, B, C: Integer ): Integer; asm @@ -19672,32 +19881,14 @@ asm IDIV ECX end; {$ENDIF} -//[END MulDiv] -//[FUNCTION Int2Hex] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal (mixed) -function Int2Hex( Value : DWord; Digits : Integer ) : AnsiString; -var Buf: array[ 0..8 ] of AnsiChar; - Dest : PAnsiChar; - - function HexDigit( B : Byte ) : AnsiChar; - {$IFDEF F_P} - const - HexDigitChr: array[ 0..15 ] of AnsiChar = ( '0','1','2','3','4','5','6','7', - '8','9','A','B','C','D','E','F' ); // TODO: FP may havn't UnicodeString - begin - Result := HexDigitChr[ B and $F ]; - end; - {$ELSE DELPHI} - asm - {$IFDEF PARANOIA} DB $3C,9 {$ELSE} CMP AL,9 {$ENDIF} - JA @@1 - {$IFDEF PARANOIA} DB $04, $30-$41+$0A {$ELSE} ADD AL,30h-41h+0Ah {$ENDIF} - @@1: - {$IFDEF PARANOIA} DB $04, $41-$0A {$ELSE} ADD AL,41h-0Ah {$ENDIF} - end; - {$ENDIF F_P/DELPHI} +{$IFDEF ASM_UNICODE}{$ELSE ASM_VERSION} //Pascal (mixed) +function Int2Hex( Value : DWord; Digits : Integer ) : KOLString; +const + HexDigitChr: array[ 0..15 ] of KOLChar = ( '0','1','2','3','4','5','6','7', + '8','9','A','B','C','D','E','F' ); +var Buf: array[ 0..8 ] of KOLChar; + Dest : PKOLChar; begin Dest := @Buf[ 8 ]; Dest^ := #0; @@ -19706,7 +19897,7 @@ begin Dest^ := '0'; if Value <> 0 then begin - Dest^ := HexDigit( Value and $F ); + Dest^ := HexDigitChr[ Value and $F ]; Value := Value shr 4; end; Dec( Digits ); @@ -19714,12 +19905,9 @@ begin Result := Dest; end; {$ENDIF ASM_VERSION} -//[END Int2Hex] -//[FUNCTION Hex2Int] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal -function Hex2Int( const Value : AnsiString) : Integer; +{$IFDEF ASM_UNICODE}{$ELSE ASM_VERSION} //Pascal +function Hex2Int( const Value : KOLString) : Integer; var I : Integer; begin Result := 0; @@ -19728,23 +19916,24 @@ begin if Value[ 1 ] = '$' then Inc( I ); while I <= Length( Value ) do begin - if Value[ I ] in [ '0'..'9' ] then - Result := (Result shl 4) or (Ord(Value[I]) - Ord('0')) + if (Value[ I ] >= '0') + and (Value[ I ] <= '9') then + Result := (Result shl 4) or (Ord(Value[I]) - Ord('0')) else - if Value[ I ] in [ 'A'..'F' ] then - Result := (Result shl 4) or (Ord(Value[I]) - Ord('A') + 10) + if (Value[ I ] >= 'A') + and (Value[ I ] <= 'F') then + Result := (Result shl 4) or (Ord(Value[I]) - Ord('A') + 10) else - if Value[ I ] in [ 'a'..'f' ] then - Result := (Result shl 4) or (Ord(Value[I]) - Ord('a') + 10) + if (Value[ I ] >= 'a') + and (Value[ I ] <= 'f') then + Result := (Result shl 4) or (Ord(Value[I]) - Ord('a') + 10) else - break; + break; Inc( I ); end; end; {$ENDIF ASM_VERSION} -//[END Hex2Int] -//[FUNCTION Octal2Int] function Octal2Int( const Value: AnsiString ) : Integer; var I: Integer; begin @@ -19756,9 +19945,7 @@ begin else break; end; end; -//[END Octal2Int] -//[FUNCTION Binary2Int] function Binary2Int( const Value: AnsiString ) : Integer; var I: Integer; begin @@ -19770,7 +19957,6 @@ begin else break; end; end; -//[END Binary2Int] function ToRadix( number: Radix_Int; radix: Integer; min_digits: Integer ): KOLString; var Buf: array[ 0..64 ] of KOLChar; @@ -19870,9 +20056,7 @@ begin end; end; -//[FUNCTION cHex2Int] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} function cHex2Int( const Value : AnsiString) : Integer; begin if StrEq( Copy( Value, 1, 2 ), '0x' ) then @@ -19880,14 +20064,11 @@ begin else Result := Hex2Int( Value ); end; {$ENDIF ASM_VERSION} -//[END cHex2Int] -//[FUNCTION Int2Str] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal -function Int2Str( Value : Integer ) : AnsiString; -var Buf : Array[ 0..15 ] of AnsiChar; - Dst : PAnsiChar; +{$IFDEF ASM_UNICODE}{$ELSE ASM_VERSION} //Pascal +function Int2Str( Value : Integer ) : KOLString; +var Buf : Array[ 0..15 ] of KOLChar; + Dst : PKOLChar; Minus : Boolean; D: DWORD; begin @@ -19902,7 +20083,7 @@ begin D := Value; repeat Dec( Dst ); - Dst^ := AnsiChar( (D mod 10) + Byte( '0' ) ); + Dst^ := KOLChar( (D mod 10) + Byte( '0' ) ); D := D div 10; until D = 0; if Minus then @@ -19913,7 +20094,6 @@ begin Result := Dst; end; {$ENDIF ASM_VERSION} -//[END Int2Str] procedure Int2PChar( s: PAnsiChar; Value: Integer ); var Buf : array[ 0..15 ] of AnsiChar; @@ -19943,7 +20123,6 @@ begin StrCopy( s, Dst ); end; -//[function UInt2Str] function UInt2Str( Value: DWORD ): AnsiString; var Buf : Array[ 0..15 ] of AnsiChar; Dst : PAnsiChar; @@ -19960,7 +20139,6 @@ begin Result := Dst; end; -//[function Int2StrEx] function Int2StrEx( Value, MinWidth: Integer ): AnsiString; begin Result := Int2Str( Value ); @@ -19968,7 +20146,6 @@ begin Result := ' ' + Result; end; -//[function Int2Rome] function Int2Rome( Value: Integer ): AnsiString; const RomeDigs = AnsiString('IVXLCDMT'); function RomeNum( N, FromIdx: Integer ): AnsiString; @@ -19998,9 +20175,7 @@ begin end; end; -//[FUNCTION Int2Ths] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function Int2Ths( I : Integer ) : AnsiString; var S : AnsiString; begin @@ -20017,11 +20192,8 @@ begin Result := '-' + CopyEnd( Result, 3 ); end; {$ENDIF ASM_VERSION} -//[END Int2Ths] -//[FUNCTION Int2Digs] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function Int2Digs( Value, Digits : Integer ) : AnsiString; var M : AnsiString; begin @@ -20041,11 +20213,8 @@ begin Result := M + Result; end; {$ENDIF ASM_VERSION} -//[END Int2Digs] -//[FUNCTION Num2Bytes] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function Num2Bytes( Value : Double ) : AnsiString; const Suffix = 'KMGT'; var V, I : Integer; @@ -20069,11 +20238,8 @@ begin Result := Result + Suffix[ I ]; end; {$ENDIF ASM_VERSION} -//[END Num2Bytes] -//[FUNCTION S2Int] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function S2Int( S: PAnsiChar ): Integer; var M : Integer; begin @@ -20097,19 +20263,14 @@ begin Result := -Result; end; {$ENDIF ASM_VERSION} -//[END S2Int] -//[FUNCTION Str2Int] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function Str2Int(const Value : AnsiString) : Integer; begin Result := S2Int( PAnsiChar( Value ) ); end; {$ENDIF ASM_VERSION} -//[END Str2Int] -//[function StrCopy] function StrCopy( Dest, Source: PAnsiChar ): PAnsiChar; assembler; asm {$IFDEF F_P} @@ -20143,7 +20304,6 @@ begin Result := Dest; end; -//[function StrScan] function StrScan(Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; assembler; asm {$IFDEF F_P} @@ -20171,7 +20331,6 @@ asm @@1: DEC EAX end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -//[function StrRScan] function StrRScan(const Str: PAnsiChar; Chr: AnsiChar): PAnsiChar; assembler; asm {$IFDEF F_P} @@ -20196,7 +20355,6 @@ asm POP EDI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -//[function StrScanLen] function StrScanLen(Str: PAnsiChar; Chr: AnsiChar; Len: Integer): PAnsiChar; assembler; asm {$IFDEF F_P} @@ -20214,7 +20372,6 @@ asm ZF = 0 if character found. } end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -//[FUNCTION TrimLeft] {$IFDEF ASM_UNICODE} function TrimLeft(const S: Ansistring): Ansistring; asm @@ -20243,9 +20400,7 @@ begin Result := Copy(S, I, Maxint); end; {$ENDIF ASM_VERSION} -//[END TrimLeft] -//[FUNCTION TrimRight] {$IFDEF ASM_UNICODE} function TrimRight(const S: Ansistring): Ansistring; asm @@ -20280,19 +20435,14 @@ begin Result := Copy(S, 1, I); end; {$ENDIF ASM_VERSION} -//[END TrimRight] -//[FUNCTION Trim] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function Trim( const S : KOLString): KOLString; begin Result := TrimLeft( TrimRight( S ) ); end; {$ENDIF ASM_VERSION} -//[END Trim] -//[function RemoveSpaces] function RemoveSpaces( const S: KOLString ): KOLString; var I: Integer; begin @@ -20301,7 +20451,6 @@ begin if S[ I ] <= ' ' then Delete( Result, I, 1 ); end; -//[procedure Str2LowerCase] procedure Str2LowerCase( S: PAnsiChar ); asm {$IFDEF F_P} @@ -20320,9 +20469,7 @@ asm @@exit: end {$IFDEF F_P} [ 'EAX', 'ECX' ] {$ENDIF}; -//[FUNCTION LowerCase] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function LowerCase(const S: Ansistring): Ansistring; var I : Integer; begin @@ -20332,11 +20479,8 @@ begin Inc( Result[ I ], 32 ); end; {$ENDIF ASM_VERSION} -//[END LowerCase] -//[FUNCTION UpperCase] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function UpperCase(const S: Ansistring): Ansistring; var I : Integer; begin @@ -20346,17 +20490,14 @@ begin Dec( Result[ I ], 32 ); end; {$ENDIF ASM_VERSION} -//[END UpperCase] {$IFDEF F_P} -//[function DummyStrFun] function DummyStrFun( const S: AnsiString ): AnsiString; begin Result := S; end; {$ENDIF F_P} -//[FUNCTION CopyEnd] {$IFDEF ASM_UNICODE} function CopyEnd( const S : AnsiString; Idx : Integer ) : AnsiString; asm @@ -20391,9 +20532,7 @@ begin Result := Copy( S, Idx, MaxInt ); end; {$ENDIF ASM_VERSION} -//[END CopyEnd] -//[FUNCTION CopyTail] {$IFDEF ASM_UNICODE} function CopyTail( const S : AnsiString; Len : Integer ) : AnsiString; asm @@ -20428,9 +20567,7 @@ begin Result := Copy( S, L - Len + 1, Len ); end; {$ENDIF ASM_VERSION} -//[END CopyTail] -//[PROCEDURE DeleteTail] {$IFDEF ASM_UNICODE} procedure DeleteTail( var S : AnsiString; Len : Integer ); asm @@ -20463,10 +20600,8 @@ begin Delete( S, L - Len + 1, Len ); end; {$ENDIF ASM_VERSION} -//[END DeleteTail] {$IFNDEF TEST_INDEXOFCHARS_COMPAT} -//[FUNCTION IndexOfChar] {$IFDEF ASM_UNICODE} function IndexOfChar( const S : KOLString; Chr : KOLChar ) : Integer; asm @@ -20504,23 +20639,8 @@ begin break; end; end; - -(* P := PKOLChar( S ); - {$IFDEF INPACKAGE} - F := StrScan( P, Chr ); - {$ELSE} - F := StrScanLen( P, Chr, Length( S ) ); - {$ENDIF} - Result := -1; - if (F = nil) or (S = '') then Exit; - Result := (Integer( F ) - Integer( P )) {$IFDEF UNICODE_CTRLS} div SizeOfKOLChar {$ENDIF} - {$IFDEF INPACKAGE} + 1 {$ENDIF}; // by byte - - if {(Result > Length(S)) or} (S[ Result ] <> Chr) then - Result := -1; *) end; {$ENDIF ASM_VERSION} -//[END IndexOfChar] {$ELSE TEST_INDEXOFCHARS_COMPAT}//////////////////////////////////////////////// function IndexOfChar_Old( const S : AnsiString; Chr : AnsiChar ) : Integer; var P, F : PAnsiChar; @@ -20562,7 +20682,24 @@ begin end; {$ENDIF} -//[FUNCTION IndexOfCharsMin] +{$IFDEF _D3orHigher} +function WIndexOfChar( const S : WideString; Chr : WideChar ) : Integer; +var i, l : integer; +begin + Result := -1; + if S = '' then exit; + l := Length(S); + for I := 1 to l do + begin + if S[I] = Chr then + begin + Result := I; + break; + end; + end; +end; +{$ENDIF} + {$IFDEF ASM_UNICODE} function IndexOfCharsMin( const S, Chars : AnsiString ) : Integer; asm PUSH ESI @@ -20616,11 +20753,26 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END IndexOfCharsMin] + +{$IFDEF _D3orHigher} +function WIndexOfCharsMin( const S, Chars : WideString ) : Integer; +var I, J : Integer; +begin + Result := -1; + for I := 1 to Length( Chars ) do + begin + J := WIndexOfChar( S, Chars[ I ] ); + if J > 0 then + begin + if (Result <= 0) or (J < Result) then + Result := J; + end; + end; +end; +{$ENDIF} {$IFNDEF _FPC} {$IFNDEF _D2} -//[function IndexOfWideCharsMin] function IndexOfWideCharsMin( const S, Chars : WideString ) : Integer; var I, J : Integer; begin @@ -20638,7 +20790,6 @@ end; {$ENDIF _D2} {$ENDIF _FPC} -//[FUNCTION IndexOfStr] {$IFDEF ASM_UNICODE} function IndexOfStr( const S, Sub : KOLString ) : Integer; asm @@ -20723,9 +20874,7 @@ begin Result := -1; end; {$ENDIF ASM_VERSION} -//[END IndexOfStr] -//[FUNCTION Parse] {$IFDEF ASM_UNICODE} //??? function Parse( var S : AnsiString; const Separators : AnsiString ) : AnsiString; asm @@ -20772,11 +20921,21 @@ begin Delete( S, 1, Pos ); end; {$ENDIF ASM_VERSION} -//[END Parse] + +{$IFDEF _D3orHigher} +function ParseW( var S : WideString; const Separators : WideString ) : WideString; +var Pos : Integer; +begin + Pos := WIndexOfCharsMin( S, Separators ); + if Pos <= 0 then + Pos := Length( S )+1; + Result := Copy( S, 1, Pos-1 ); + Delete( S, 1, Pos ); +end; +{$ENDIF} {$IFNDEF _FPC} {$IFNDEF _D2} -//[function WParse] function WParse( var S : WideString; const Separators : WideString ) : WideString; var Pos : Integer; begin @@ -20790,7 +20949,6 @@ end; {$ENDIF _D2} {$ENDIF _FPC} -//[function ParsePascalString] function ParsePascalString( var S : AnsiString; const Separators : AnsiString ) : AnsiString; var Pos, Idx : Integer; Hex, Spc : Boolean; @@ -20888,7 +21046,6 @@ begin end; end; -//[function String2PascalStrExpr] function String2PascalStrExpr( const S : AnsiString ) : AnsiString; var I, Strt : Integer; function String2DoubleQuotas( const S : AnsiString ) : AnsiString; @@ -20944,7 +21101,6 @@ begin end; end; -//[function CompareMem] function CompareMem(P1, P2: Pointer; Length: Integer): Boolean; assembler; asm {$IFDEF F_P} @@ -20971,9 +21127,7 @@ asm POP ESI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -//[FUNCTION AllocMem] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function AllocMem( Size : Integer ) : Pointer; begin Result := nil; @@ -20984,9 +21138,7 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END AllocMem] -//[procedure DisposeMem] procedure DisposeMem( var Addr : Pointer ); begin if Addr <> nil then @@ -20995,8 +21147,7 @@ begin end; {$IFDEF WIN} -//[function AnsiUpperCase] -function AnsiUpperCase(const S: Ansistring): Ansistring; +function AnsiUpperCase(const S: AnsiString): AnsiString; var Len: Integer; begin Len := Length(S); @@ -21004,7 +21155,6 @@ begin if Len > 0 then CharUpperBuffA(Pointer(Result), Len); end; -//[function AnsiLowerCase] function AnsiLowerCase(const S: Ansistring): Ansistring; var Len: Integer; @@ -21013,12 +21163,47 @@ begin SetString(Result, PAnsiChar(S), Len); if Len > 0 then CharLowerBuffA(Pointer(Result), Len); end; + +function KOLUpperCase(const S: KOLString): KOLString; +var Len: Integer; +begin + Len := Length(S); + SetString(Result, PKOLChar( S ), Len); + if Len > 0 then CharUpperBuff(PKOLChar(Result), Len); +end; + +function KOLLowerCase(const S: KOLString): KOLString; +var + Len: Integer; +begin + Len := Length(S); + SetString(Result, PKOLChar(S), Len); + if Len > 0 then CharLowerBuff(PKOLChar(Result), Len); +end; + +{$IFDEF _D3orHigher} +function WUpperCase(const S: WideString): WideString; +var Len: Integer; +begin + Len := Length(S); + SetString(Result, PWideChar( S ), Len); + if Len > 0 then CharUpperBuffW(PWideChar(Result), Len); +end; + +function WLowerCase(const S: WideString): WideString; +var + Len: Integer; +begin + Len := Length(S); + SetString(Result, PWideChar(S), Len); + if Len > 0 then CharLowerBuffW(PWideChar(Result), Len); +end; +{$ENDIF} {$ENDIF WIN} {$IFNDEF _D2} {$IFNDEF _FPC} -//[function WAnsiUpperCase] {$IFDEF WIN} function WAnsiUpperCase(const S: WideString): WideString; var Len: Integer; @@ -21029,7 +21214,6 @@ begin end; {$ENDIF WIN} -//[function WAnsiLowerCase] {$IFDEF WIN} function WAnsiLowerCase(const S: WideString): WideString; var Len: Integer; @@ -21093,7 +21277,6 @@ end; {$ENDIF _FPC} {$ENDIF _D2} -//[function AnsiCompareStr] {$IFDEF WIN} function AnsiCompareStr(const S1, S2: KOLString): Integer; begin @@ -21101,7 +21284,6 @@ begin end; {$ENDIF WIN} -//[function AnsiCompareStrA] {$IFDEF WIN} function AnsiCompareStrA(const S1, S2: AnsiString): Integer; begin @@ -21109,7 +21291,6 @@ begin end; {$ENDIF WIN} -//[function _AnsiCompareStr] {$IFDEF WIN} function _AnsiCompareStr(S1, S2: PKOLChar): Integer; begin @@ -21118,7 +21299,6 @@ begin end; {$ENDIF WIN} -//[function _AnsiCompareStrA] {$IFDEF WIN} function _AnsiCompareStrA(S1, S2: PAnsiChar): Integer; begin @@ -21127,7 +21307,6 @@ begin end; {$ENDIF WIN} -//[function AnsiCompareStrNoCase] {$IFDEF WIN} function AnsiCompareStrNoCase(const S1, S2: KOLString): Integer; begin @@ -21136,7 +21315,6 @@ begin end; {$ENDIF WIN} -//[function AnsiCompareStrNoCaseA] {$IFDEF WIN} function AnsiCompareStrNoCaseA(const S1, S2: AnsiString): Integer; begin @@ -21145,7 +21323,6 @@ begin end; {$ENDIF WIN} -//[function _AnsiCompareStrNoCase] {$IFDEF WIN} function _AnsiCompareStrNoCase(S1, S2: PKOLChar): Integer; begin @@ -21154,7 +21331,6 @@ begin end; {$ENDIF WIN} -//[function _AnsiCompareStrNoCaseA] {$IFDEF WIN} function _AnsiCompareStrNoCaseA(S1, S2: PAnsiChar): Integer; begin @@ -21163,19 +21339,16 @@ begin end; {$ENDIF WIN} -//[function AnsiCompareText] function AnsiCompareText( const S1, S2: KOLString ): Integer; begin Result := AnsiCompareStrNoCase( S1, S2 ); end; -//[function AnsiCompareTextA] function AnsiCompareTextA( const S1, S2: AnsiString ): Integer; begin Result := AnsiCompareStrNoCaseA( S1, S2 ); end; -//[function StrLCopy] function StrLCopy(Dest: PAnsiChar; const Source: PAnsiChar; MaxLen: Cardinal): PAnsiChar; assembler; asm {$IFDEF F_P} @@ -21212,40 +21385,30 @@ asm POP EDI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -//[FUNCTION StrPCopy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function StrPCopy(Dest: PAnsiChar; const Source: Ansistring): PAnsiChar; begin Result := StrLCopy(Dest, PAnsiChar(Source), Length(Source)); end; {$ENDIF ASM_VERSION} -//[END StrPCopy] -//[FUNCTION StrEq] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function StrEq( const S1, S2 : AnsiString ) : Boolean; begin Result := (Length( S1 ) = Length( S2 )) and (LowerCase( S1 ) = LowerCase( S2 )); end; {$ENDIF ASM_VERSION} -//[END StrEq] -//[FUNCTION AnsiEq] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function AnsiEq( const S1, S2 : KOLString ) : Boolean; begin Result := AnsiCompareStrNoCase( S1, S2 ) = 0; end; {$ENDIF ASM_VERSION} -//[END AnsiEq] {$IFNDEF _D2} {$IFNDEF _FPC} -//[function WAnsiEq] function WAnsiEq( const S1, S2 : WideString ) : Boolean; begin Result := WAnsiLowerCase( S1 )=WAnsiLowerCase( S2 ); @@ -21253,9 +21416,7 @@ end; {$ENDIF _FPC} {$ENDIF _D2} -//[FUNCTION StrIn] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function StrIn(const S: AnsiString; const A: array of String): Boolean; var I : Integer; begin @@ -21268,11 +21429,9 @@ begin Result := False; end; {$ENDIF ASM_VERSION} -//[END StrIn] {$IFNDEF _D2} {$IFNDEF _FPC} -//[function WStrIn] function WStrIn( const S : WideString; const A : array of WideString ) : Boolean; var I : Integer; begin @@ -21292,7 +21451,6 @@ begin Result := (DWord( C ) <= 255) and (AnsiChar( C ) in A); end; -//[function StrIs] function StrIs( const S : AnsiString; const A : Array of AnsiString; var Idx: Integer ) : Boolean; var I : Integer; begin @@ -21307,7 +21465,6 @@ begin Result := False; end; -//[function IntIn] function IntIn( Value: Integer; const List: array of Integer ): Boolean; var I: Integer; begin @@ -21322,7 +21479,6 @@ begin end; end; -//[FUNCTION _StrSatisfy] {$IFDEF ASM_UNICODE} function _StrSatisfy( S, Mask : PKOLChar ) : Boolean; asm @@ -21436,9 +21592,7 @@ next_char: if Result then goto next_char; end; {$ENDIF ASM_VERSION} -//[END _StrSatisfy] -//[FUNCTION StrSatisfy] {$IFDEF ASM_UNICODE} function StrSatisfy( const S, Mask: AnsiString ): Boolean; asm @@ -21485,9 +21639,7 @@ begin {$ELSE} AnsiLowerCase {$ENDIF} ( Mask ) ) ); end; {$ENDIF ASM_VERSION} -//[END StrSatisfy] -//[FUNCTION _2StrSatisfy] {$IFDEF ASM_UNICODE} function _2StrSatisfy( S, Mask: PAnsiChar ): Boolean; asm // // @@ -21525,9 +21677,7 @@ begin Result := StrSatisfy( S, Mask ); end; {$ENDIF ASM_VERSION} -//[END _2StrSatisfy] -//[function StrReplace] function StrReplace( var S: AnsiString; const From, ReplTo: AnsiString ): Boolean; var I: Integer; begin @@ -21552,9 +21702,7 @@ begin else Result := FALSE; end; -{-} {$IFDEF _FPC} -//[procedure SetLengthW] procedure SetLengthW( var W: WideString; NewLength: Integer ); begin while Length( W ) < NewLength do @@ -21563,7 +21711,6 @@ begin Delete( W, NewLength + 1, Length( W ) - NewLength ); end; -//[function CopyW] function CopyW( const W: WideString; From, Count: Integer ): WideString; begin Result := ''; @@ -21572,7 +21719,6 @@ begin Move( W[ From ], Result[ 1 ], Count * Sizeof( WideChar ) ); end; -//[function posW] function posW( const S1, S2: AnsiString ): Integer; var I, L1: Integer; begin @@ -21591,7 +21737,6 @@ end; {$IFNDEF _FPC} {$IFNDEF _D2} -//[function WStrReplace] function WStrReplace( var S: WideString; const From, ReplTo: WideString ): Boolean; var I: Integer; begin @@ -21604,7 +21749,6 @@ begin else Result := FALSE; end; -//[function WStrRepeat] function WStrRepeat( const S: WideString; Count: Integer ): WideString; var I, L: Integer; begin @@ -21616,8 +21760,6 @@ end; {$ENDIF _D2} {$ENDIF _FPC} -{+} -//[function StrRepeat] function StrRepeat( const S: AnsiString; Count: Integer ): AnsiString; var I, L: Integer; begin @@ -21627,7 +21769,6 @@ begin Move( S[ 1 ], Result[ 1 + I * L ], L ); end; -//[PROCEDURE NormalizeUnixText] {$IFDEF ASM_noVERSION} {$ELSE ASM_VERSION} //Pascal procedure NormalizeUnixText( var S: AnsiString ); @@ -21667,7 +21808,6 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END NormalizeUnixText] var Koi8_to_Ansi: array[ Char ] of AnsiChar; procedure Koi8ToAnsi( s: PAnsiChar ); @@ -21704,7 +21844,6 @@ begin end; end; -//[function StrComp] function StrComp(const Str1, Str2: PAnsiChar): Integer; assembler; asm {$IFDEF F_P} @@ -21733,12 +21872,16 @@ var Upper: array[ AnsiChar ] of AnsiChar; Upper_initialized: Boolean; procedure Init_Upper; -var c: Char; +var c: AnsiChar; + s: AnsiString; begin if not Upper_initialized then begin for c := Low(c) to High(c) do - Upper[c] := AnsiUpperCase(c+' ')[1]; + begin + s := c + AnsiChar( ' ' ); + Upper[c] := AnsiUpperCase( s )[1]; + end; Upper_initialized := TRUE; end; end; @@ -21788,7 +21931,6 @@ asm POP EDI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -//[function StrLComp_NoCase] function StrLComp_NoCase(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; asm {$IFDEF F_P} @@ -21845,7 +21987,8 @@ asm {$ENDIF F_P} PUSH ESI XCHG ESI, EAX - @@1: MOVZX EAX, BYTE PTR [EDX] + @@1: + MOVZX EAX, BYTE PTR [EDX] INC EDX MOV CL, BYTE PTR [EAX+Upper] LODSB @@ -21854,6 +21997,7 @@ asm CMP AL, CL JNZ @@1 @@fin:MOVSX EAX, CL + NEG EAX POP ESI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; @@ -21864,7 +22008,6 @@ begin Result := StrComp_NoCase2( Str1, Str2 ); end; -//[function StrLComp_NoCase] function StrLComp_NoCase2(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; asm {$IFDEF F_P} @@ -21901,7 +22044,6 @@ begin end; {$ENDIF} -//[function StrLComp] function StrLComp(const Str1, Str2: PAnsiChar; MaxLen: Cardinal): Integer; assembler; asm {$IFDEF F_P} @@ -21932,7 +22074,6 @@ asm POP EDI end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -//[function StrLen] function StrLen(const Str: PAnsiChar): Cardinal; assembler; asm {$IFDEF F_P} @@ -21952,7 +22093,6 @@ asm MOV EDI,EDX end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; -//[FUNCTION __DelimiterLast] {$IFDEF ASM_UNICODE} {$ELSE ASM_VERSION} //Pascal function __DelimiterLast( Str, Delimiters: PKOLChar ): PKOLChar; @@ -21972,7 +22112,6 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END __DelimiterLast] {$IFDEF _D3orHigher} function W__DelimiterLast( Str, Delimiters: PWideChar ): PWideChar; @@ -21992,7 +22131,6 @@ begin end; {$ENDIF _D3orHigher} -//[function SkipSpaces] function SkipSpaces( P: PKOLChar ): PKOLChar; begin while True do @@ -22003,7 +22141,6 @@ begin Result := P; end; -//[function SkipParam] function SkipParam(P: PKOLChar): PKOLChar; begin P := SkipSpaces( P ); @@ -22021,7 +22158,6 @@ begin end; {$IFDEF WIN} -//[FUNCTION ParamStr] function ParamStr( Idx: Integer ): KOLString; var P, P1: PKOLChar; @@ -22045,9 +22181,7 @@ begin Result := Copy( Result, 2, Length( Result ) - 2 ); end; end; -//[END ParamStr] -//[FUNCTION ParamCount] function ParamCount: Integer; var S: Ansistring; @@ -22060,10 +22194,8 @@ begin Inc(Result); end; end; -//[END ParamCount] {$ENDIF WIN} -//[FUNCTION DelimiterLast] {$IFDEF ASM_UNICODE} function __DelimiterLast( Str: PAnsiChar; Delimiters: PAnsiChar ): PAnsiChar; asm @@ -22131,10 +22263,8 @@ begin {$IFDEF UNICODE_CTRLS} Result := Result div SizeOf( WideChar ) {$ENDIF}; end; {$ENDIF ASM_VERSION} -//[END DelimiterLast] // Thanks to Marco Bobba - Marisa Bo for this code -//[function StrIsStartingFrom] {$IFDEF ASM_UNICODE} function StrIsStartingFrom( Str, Pattern: PKOLChar ): Boolean; asm @@ -22208,7 +22338,6 @@ asm end {$IFDEF F_P} [ 'EAX', 'EDX', 'ECX' ] {$ENDIF}; {$IFDEF WIN} {$IFNDEF _FPC} -//[FUNCTION Format] {$IFDEF ASM_UNICODE} function Format( const fmt: KOLString; params: array of const ): AnsiString; asm @@ -22276,10 +22405,8 @@ begin FreeMem( ElsArray ); end; {$ENDIF ASM_VERSION} -//[END Format] {$ENDIF WIN} -//[function LStrFromPWCharLen] function LStrFromPWCharLen(Source: PWideChar; Length: Integer): AnsiString; var DestLen: Integer; @@ -22306,7 +22433,6 @@ begin WideCharToMultiByte(0, 0, Source, Length, Pointer(Result), DestLen, nil, nil); end; -//[function LStrFromPWChar] function LStrFromPWChar(Source: PWideChar): AnsiString; {* from Delphi5 - because D2 does not contain it. } asm @@ -22353,7 +22479,6 @@ end; // // ///////////////////////////////////////////////////////////////////////// -//[FILES] { This part of the unit modified by Tim Slusher and Vladimir Kladov. } @@ -22373,10 +22498,8 @@ end; {$DEFINE ASM_LOCAL} {$ENDIF ASM_VERSION} -//[FUNCTION FileCreate] {$IFDEF WIN} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function FileCreate(const FileName: KOLString; OpenFlags: DWord): THandle; var Attr: DWORD; begin @@ -22388,7 +22511,6 @@ begin end; {$ENDIF ASM_VERSION} {$ENDIF WIN} -//[END FileCreate] {$IFDEF _D3orHigher} function WFileCreate(const FileName: WideString; OpenFlags: DWord): THandle; @@ -22402,17 +22524,14 @@ begin end; {$ENDIF _D3orHigher} -//[FUNCTION FileClose] {$IFDEF WIN} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function FileClose(Handle: THandle): Boolean; begin Result := CloseHandle(Handle); end; {$ENDIF ASM_VERSION} {$ENDIF WIN} -//[END FileClose] {$UNDEF ASM_LOCAL} {$IFDEF ASM_UNICODE} @@ -22422,7 +22541,6 @@ end; {$UNDEF ASM_LOCAL} {$ENDIF} -//[FUNCTION FileExists] {$IFDEF WIN} {$IFDEF ASM_LOCAL} function FileExists( const FileName : KOLString ) : Boolean; @@ -22463,7 +22581,6 @@ begin end; {$ENDIF ASM_VERSION} {$ENDIF WIN} -//[END FileExists] {$IFDEF _D3orHigher} function WFileExists( const FileName: WideString ) : Boolean; @@ -22490,7 +22607,6 @@ begin end; {$ENDIF _D3orHigher} -//[FUNCTION FileSeek] {$IFDEF WIN} {$IFDEF ASM_STREAM} function FileSeek(Handle: THandle; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveMethod: TMoveMethod): TStrmSize; @@ -22522,12 +22638,9 @@ begin end; {$ENDIF ASM_VERSION} {$ENDIF WIN} -//[END FileSeek] -//[FUNCTION FileRead] {$IFDEF WIN} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function FileRead(Handle: THandle; var Buffer; Count: DWord): DWord; begin if not ReadFile(Handle, Buffer, Count, Result, nil) then @@ -22535,11 +22648,8 @@ begin end; {$ENDIF ASM_VERSION} {$ENDIF WIN} -//[END FileRead] -//[FUNCTION File2Str] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function File2Str(Handle: THandle): AnsiString; var Pos, Size: DWORD; begin @@ -22552,7 +22662,6 @@ begin Result[ Size - Pos + 1 ] := #0; end; {$ENDIF ASM_VERSION} -//[END File2Str] {$IFNDEF _D2} function File2WStr(Handle: THandle): WideString; @@ -22568,10 +22677,8 @@ begin end; {$ENDIF _D2} -//[FUNCTION FileWrite] {$IFDEF WIN} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function FileWrite(Handle: THandle; const Buffer; Count: DWord): DWord; begin if not WriteFile(Handle, Buffer, Count, Result, nil) then @@ -22579,11 +22686,8 @@ begin end; {$ENDIF ASM_VERSION} {$ENDIF WIN} -//[END FileWrite] -//[FUNCTION FileEOF] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function FileEOF( Handle: THandle ) : Boolean; var Siz, Pos : DWord; begin @@ -22592,9 +22696,7 @@ begin Result := Pos >= Siz; end; {$ENDIF ASM_VERSION} -//[END FileEOF] -//[FUNCTION FileFullPath] {$IFDEF WIN} {$IFDEF ASM_noVERSION_UNICODE} function FileFullPath( const FileName: AnsiString ) : AnsiString; @@ -22718,10 +22820,8 @@ begin end; {$ENDIF ASM_VERSION} {$ENDIF WIN} -//[END FileFullPath] {$IFDEF WIN} -//[function FileShortPath] function FileShortPath( const FileName: KOLString ): KOLString; var Buf: array[ 0..MAX_PATH ] of KOLChar; begin @@ -22729,7 +22829,6 @@ begin Result := Buf; end; -//[function FileIconSystemIdx] function FileIconSystemIdx( const Path: KOLString ): Integer; var SFI: TShFileInfo; begin @@ -22739,7 +22838,6 @@ begin Result := SFI.iIcon; end; -//[function FileIconSysIdxOffline] function FileIconSysIdxOffline( const Path: KOLString ): Integer; var SFI: TShFileInfo; begin @@ -22751,7 +22849,6 @@ begin end; {$ENDIF WIN} -//[procedure LogFileOutput] procedure LogFileOutput( const filepath, str: KOLString ); var F: THandle; Tmp: KOLString; @@ -22764,7 +22861,6 @@ begin FileClose( F ); end; -//[function StrLoadFromFile] function StrLoadFromFile( const Filename: KOLString ): AnsiString; var F: THandle; begin @@ -22796,7 +22892,6 @@ begin Result := Mem2File( Filename, Str, L * Sizeof(WideChar) ) = L; end; -//[function StrSaveToFile] function StrSaveToFile( const Filename: KOLString; const Str: AnsiString ): Boolean; begin Result := Mem2File( PKOLChar( Filename ), PAnsiChar( Str ), Length( Str ) ) @@ -22831,7 +22926,6 @@ end; {$ENDIF _D2} -//[function Mem2File] function Mem2File( Filename: PKOLChar; Mem: Pointer; Len: Integer ): Integer; var F: THandle; begin @@ -22842,7 +22936,6 @@ begin FileClose( F ); end; -//[function File2Mem] function File2Mem( Filename: PKOLChar; Mem: Pointer; MaxLen: Integer ): Integer; var F: THandle; begin @@ -22873,7 +22966,6 @@ begin end; {$ENDIF WIN} -//[FUNCTION FileSize] {$IFDEF WIN} function FileSize( const Path: KOLString ) : {$IFDEF _D2orD3} Integer {$ELSE} Int64 {$ENDIF}; var FD : TFindFileData; @@ -22889,9 +22981,7 @@ begin Find_Close( FD ); end; {$ENDIF WIN} -//[END FileSize] -//[procedure FileTime] procedure FileTime( const Path: KOLString; CreateTime, LastAccessTime, LastModifyTime: PFileTime ); var FD : TFindFileData; @@ -22906,7 +22996,6 @@ begin Find_Close( FD ); end; -//[function GetUniqueFilename] function GetUniqueFilename( PathName: KOLString ) : KOLString; var Path, Nam, Ext : KOLString; I, J, K : Integer; @@ -22939,9 +23028,7 @@ begin end; {$IFDEF WIN} -//[FUNCTION CompareSystemTime] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function CompareSystemTime(const D1, D2 : TSystemTime) : Integer; var R: Integer; procedure CompareFields(const F1, F2 : Integer); @@ -22965,9 +23052,7 @@ begin Result := R; end; {$ENDIF ASM_VERSION} -//[END CompareSystemTime] -//[function FileTimeCompare] function FileTimeCompare( const FT1, FT2 : TFileTime ) : Integer; var ST1, ST2 : TSystemTime; begin @@ -22978,9 +23063,7 @@ end; {$ENDIF WIN} {$IFDEF WIN} -//[FUNCTION DirectoryExists] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function DirectoryExists(const Name: KOLString): Boolean; var Code: Integer; @@ -22992,7 +23075,6 @@ begin SetErrorMode( e ); end; {$ENDIF ASM_VERSION} -//[END DirectoryExists] function DiskPresent( const DrivePath: KOLString ): Boolean; var e: DWORD; @@ -23026,7 +23108,6 @@ end; {$ENDIF WIN} -//[function CheckDirectoryContent] function CheckDirectoryContent( const Name: KOLString; SubDirsOnly: Boolean; const Mask: AnsiString ): Boolean; var FD: TFindFileData; begin @@ -23055,19 +23136,16 @@ begin end; end; -//[function DirectoryEmpty] function DirectoryEmpty(const Name: KOLString): Boolean; begin Result := CheckDirectoryContent( Name, FALSE, '*.*' ); end; -//[function DirectoryHasSubdirs] function DirectoryHasSubdirs( const Path: KOLString ): Boolean; begin Result := not CheckDirectoryContent( Path, TRUE, '*.*' ); end; -//[FUNCTION GetStartDir] {$IFDEF ASM_UNICODE} function GetStartDir : AnsiString; asm @@ -23125,9 +23203,7 @@ begin {$ENDIF} end; {$ENDIF ASM_VERSION} -//[END GetStartDir] -//[FUNCTION ExePath] function ExePath: KOLString; var Buffer: array[ 0..MAX_PATH+1 ] of KOLChar; begin @@ -23144,8 +23220,6 @@ begin Result := Buffer; end; -{-} -//[function DirectorySize] function DirectorySize( const Path: KOLString ): I64; var DirList: PDirList; I: Integer; @@ -23162,10 +23236,8 @@ begin end; DirList.Free; end; -{+} {$IFDEF WIN} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -//[function GetFileList] function GetFileList(const dir: Ansistring): PStrList; var Srch: TFindFileData; @@ -23186,7 +23258,6 @@ begin end; {$ENDIF WIN} -//[function ExcludeTrailingChar] function ExcludeTrailingChar( const S: KOLString; C: KOLChar ): KOLString; begin Result := S; @@ -23195,7 +23266,6 @@ begin Delete( Result, Length( Result ), 1 ); end; -//[function IncludeTrailingChar] {$IFDEF ASM_UNICODE} function IncludeTrailingChar( const S: KOLString; C: KOLChar ): KOLString; asm @@ -23246,13 +23316,11 @@ end; // IncludeTrailingPathDelimiter, ExcludeTrailingPathDelimiter, // ForceDirectories, CreateDir, ChangeFileExt //--------------------------------------------------------- -//[function IncludeTrailingPathDelimiter] function IncludeTrailingPathDelimiter(const S: KOLString): KOLString; begin Result := IncludeTrailingChar( S, {$IFDEF UNIX} '/' {$ELSE} '\' {$ENDIF} ); end; -//[function ExcludeTrailingPathDelimiter] function ExcludeTrailingPathDelimiter(const S: KOLString): KOLString; begin Result := ExcludeTrailingChar( S, {$IFDEF UNIX} '/' {$ELSE} '\' {$ENDIF} ); @@ -23286,7 +23354,6 @@ begin Result := Result + ':\'; end; -//[FUNCTION ExtractFilePath] {$IFDEF ASM_LStrFromPCharLen} // LStrFromPCharLen - there are no in D2 function ExtractFilePath( const Path : AnsiString ) : AnsiString; asm @@ -23338,8 +23405,7 @@ begin end; {$ENDIF} -{$IFDEF ASM_VERSION} -{$IFNDEF _D2} +{$IFDEF ASM_VERSION}{$IFNDEF _D2} {$DEFINE ASM_LStrFromPCharLen} {$ENDIF} {$ENDIF ASM_VERSION} @@ -23349,7 +23415,6 @@ begin Result := (Length( Path ) >= 2) and (Path[1] = '\') and (Path[2] = '\'); end; -//[FUNCTION ExtractFileName] {$IFDEF ASM_UNICODE} const DirDelimiters: PAnsiChar = ':\/'; @@ -23381,9 +23446,7 @@ begin Result := P + 1; end; {$ENDIF ASM_VERSION} -//[END ExtractFileName] -//[function ExtractFileNameWOext] {$IFDEF ASM_UNICODE} function ExtractFileNameWOext( const Path : KOLString ) : KOLString; asm @@ -23427,7 +23490,6 @@ end; const ExtDelimeters: PAnsiChar = '.'; -//[function ExtractFileExt] function ExtractFileExt( const Path : KOLString ) : KOLString; asm PUSH EDX @@ -23453,9 +23515,7 @@ begin Result := P; end; {$ENDIF ASM_VERSION} -//[END ExtractFilePath] -//[function ReplaceExt] {$IFDEF ASM_UNICODE} function ReplaceExt( const Path, NewExt: KOLString ): KOLString; asm @@ -23494,7 +23554,6 @@ begin end; {$ENDIF} -//[function ForceDirectories] function ForceDirectories(Dir: KOLString): Boolean; begin Result := Length(Dir) > 0; {Centronix} @@ -23505,7 +23564,6 @@ begin Result := ForceDirectories(ExtractFilePath(Dir)) and CreateDir(Dir); end; -//[function CreateDir] function CreateDir(const Dir: KOLString): Boolean; begin Result := {$IFDEF WIN} {Windows.}CreateDirectory(PKOLChar(Dir), nil) @@ -23513,7 +23571,6 @@ begin {$ENDIF}; end; -//[function ChangeFileExt] function ChangeFileExt(FileName: KOLString; const Extension: KOLString): KOLString; var FileExt: KOLString; @@ -23523,7 +23580,6 @@ begin Result := FileName+ Extension; end; -//[function ReplaceFileExt] function ReplaceFileExt( const Path, NewExt: KOLString ): KOLString; begin Result := ExtractFilePath( Path ) + @@ -23532,7 +23588,6 @@ begin end; {$IFDEF WIN} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -//[function ExtractShortPathName] function ExtractShortPathName( const Path: KOLString ): KOLString; var Buffer: array[0..MAX_PATH - 1] of KOLChar; @@ -23542,13 +23597,11 @@ begin end; {$IFDEF GDI} -//[function FilePathShortened] function FilePathShortened( const Path: KOLString; MaxLen: Integer ): KOLString; begin Result := FilePathShortenPixels( Path, 0, MaxLen ); end; -//[function PixelsLength] function PixelsLength( DC: HDC; const Text: KOLString ): Integer; var Sz: TSize; begin @@ -23563,7 +23616,6 @@ begin end; end; -//[function FilePathShortenPixels] function FilePathShortenPixels( const Path: KOLString; DC: HDC; MaxPixels: Integer ): KOLString; var L0, L1: Integer; Prev: KOLString; @@ -23605,7 +23657,6 @@ begin end; {$ENDIF GDI} -//[procedure CutFirstDirectory] procedure CutFirstDirectory(var S: KOLString); var Root: Boolean; @@ -23638,7 +23689,6 @@ begin end; {$IFDEF GDI} -//[function MinimizeName] function MinimizeName( const Path: KOLString; DC: HDC; MaxPixels: Integer ): KOLString; var Drive, Dir, Name: KOLString; @@ -23670,7 +23720,6 @@ begin end; {$ENDIF GDI} -//[function GetSystemDir] function GetSystemDir: KOLString; var Buf: array[ 0..MAX_PATH ] of KOLChar; begin @@ -23678,8 +23727,6 @@ begin Result := IncludeTrailingPathDelimiter( PKOLChar( @ Buf[ 0 ] ) ); end; -//* -//[function GetWindowsDir] function GetWindowsDir : KOLString; var Buf : array[ 0..MAX_PATH ] of KOLChar; begin @@ -23688,7 +23735,6 @@ begin end; {$ENDIF WIN} //^^^^^^^^^^^ -//[function GetWorkDir] {$IFDEF WIN} function GetWorkDir : KOLString; var Buf: array[ 0..MAX_PATH ] of KOLChar; @@ -23698,7 +23744,6 @@ begin end; {$ENDIF WIN} -//[function GetTempDir] {$IFDEF ASM_UNICODE} function GetTempDir : KOLString; asm @@ -23730,7 +23775,6 @@ end; {$ENDIF} {$IFDEF WIN} -//[function CreateTempFile] {$IFDEF ASM_UNICODE} function CreateTempFile( const DirPath, Prefix: KOLString ): KOLString; asm @@ -23761,7 +23805,6 @@ end; {$ENDIF ASM_VERSION} {$ENDIF WIN} -//[function GetFileListStr] function GetFileListStr(FPath{e.g.'c:\tmp\'}, FMask{e.g.'*.*'}: KOLString): KOLString; {* List of files in string, separating each path from others with FileOpSeparator. E.g.: 'c:\tmp\unit1.dcu'#13'c:\tmp\unit1.~pa' (for use with DeleteFile2Recycle())} @@ -23786,7 +23829,6 @@ begin Find_Close(Srch); end; -//[function DeleteFiles] function DeleteFiles( const DirPath: KOLString ): Boolean; var Files, Name: KOLString; begin @@ -23800,14 +23842,12 @@ begin end; {$IFDEF WIN_GDI} //>>>>>>>>>>>> -//[function DeleteFile2Recycle] function DeleteFile2Recycle( const Filename : KOLString ) : Boolean; begin Result := DoFileOp( Filename, '', FO_DELETE, FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SIMPLEPROGRESS, 'Deleting...' ); end; -//[function CopyMoveFiles] function CopyMoveFiles( const FromList, ToList: KOLString; Move: Boolean ): Boolean; begin Result := DoFileOp(FromList, ToList, FO_COPY - Integer( Move ), @@ -23815,8 +23855,6 @@ begin end; -{-} -//[function DiskFreeSpace] function DiskFreeSpace( const Path: KOLString ): I64; type TGetDFSEx = function( Path: PKOLChar; CallerFreeBytes, TotalBytes, FreeBytes: Pointer ) : Bool; stdcall; @@ -23829,8 +23867,7 @@ var GetDFSEx: TGetDFSEx; begin GetDFSEx := nil; V.dwOSVersionInfoSize := Sizeof( V ); - GetVersionEx - ( POSVersionInfo( @ V )^ ); // bug in Windows.pas ! + GetVersionEx( POSVersionInfo( @ V )^ ); // bug in Windows.pas ! Ex := FALSE; if V.dwPlatformId = VER_PLATFORM_WIN32_NT then begin @@ -23853,19 +23890,18 @@ begin Kern32 := GetModuleHandle( 'kernel32' ); GetDFSEx := GetProcAddress( Kern32, 'GetDiskFreeSpaceExA' ); end; + //////////////////////////// if Assigned( GetDFSEx ) then - GetDFSEx( PKOLChar( Path ), @ FBA, @ TNB, @Result ) + //////////////////////////// + GetDFSEx( PKOLChar( Path ), @ FBA, @ TNB, @Result ) else begin - GetDiskFreeSpace( PKOLChar( Path ), SpC, BpS, NFC, TNC ); - Result := Mul64i( MakeInt64( SpC * BpS, 0 ), NFC ); + GetDiskFreeSpace( PKOLChar( Path ), SpC, BpS, NFC, TNC ); + Result := Mul64i( MakeInt64( SpC * BpS, 0 ), NFC ); end; end; -{+} -//[END FILES] -//[function DoFileOp] function DoFileOp( const FromList, ToList: KOLString; FileOp: UINT; Flags: Word; Title: PKOLChar): Boolean; var FOS : {$IFDEF UNICODE_CTRLS}TSHFileOpStructW{$ELSE}TSHFileOpStruct{$ENDIF}; @@ -23894,7 +23930,6 @@ end; {$ENDIF WIN_GDI} {$IFDEF WIN} -//[function DirIconSysIdxOffline] function DirIconSysIdxOffline( const Path: KOLString ): Integer; var SFI: TShFileInfo; begin @@ -23908,29 +23943,25 @@ end; { TDirList } -//[function NewDirList] function NewDirList( const DirPath, Filter: KOLString; Attr: DWORD ): PDirList; begin - {-} New( Result, Create ); - {+}{++}(*Result := PDirList.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TDirList'; + {$ENDIF} Result.ScanDirectory( DirPath, Filter, Attr ); end; -//[END NewDirList] -//[function NewDirListEx] function NewDirListEx( const DirPath, Filters: KOLString; Attr: DWORD ): PDirList; begin - {-} New( Result, Create ); - {+}{++}(*Result := PDirList.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TDirListEx'; + {$ENDIF} Result.ScanDirectoryEx( DirPath, Filters, Attr ); end; -//[END NewDirListEx] -//[procedure TDirList.Clear] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TDirList.Clear; begin if FList <> nil then @@ -23939,9 +23970,7 @@ begin end; {$ENDIF ASM_VERSION} -//[destructor TDirList.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TDirList.Destroy; begin Clear; @@ -23950,7 +23979,6 @@ begin end; {$ENDIF ASM_VERSION} -//[FUNCTION FindFilter] {$IFDEF ASM_UNICODE} function FindFilter( const Filter: AnsiString): AnsiString; asm @@ -23975,18 +24003,14 @@ begin if Result = '' then Result := '*.*'; end; {$ENDIF ASM_VERSION} -//[END FindFilter] //+ -//[function TDirList.Get] function TDirList.Get(Idx: Integer): PFindFileData; begin Result := FList.Items[ Idx ]; end; -//[function TDirList.GetCount] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TDirList.GetCount: Integer; begin Result := 0; @@ -23995,7 +24019,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TDirList.GetNames] {$IFDEF ASM_UNICODE} function TDirList.GetNames(Idx: Integer): Ansistring; asm @@ -24027,14 +24050,12 @@ begin end; {$ENDIF ASM_VERSION} -//[function TDirList.GetIsDirectory] function TDirList.GetIsDirectory(Idx: Integer): Boolean; begin Result := LongBool( Items[ Idx ].dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY ); end; {$IFDEF ASM_noVERSION} -//[function TDirList.SatisfyFilter] function TDirList.SatisfyFilter(FileName: PAnsiChar; FileAttr, FindAttr: DWord): Boolean; asm @@ -24210,7 +24231,6 @@ end; {$ENDIF ASM_VERSION} {$IFDEF ASM_nononoVERSION} -//[procedure TDirList.ScanDirectory] procedure TDirList.ScanDirectory(const DirPath, Filter: KOLString; Attr: DWord); const sz_win32finddata = sizeof(TWin32FindData); @@ -24373,7 +24393,7 @@ begin FPath := DirPath; if FPath = '' then Exit; FPath := IncludeTrailingPathDelimiter( FPath ); - if not Assigned(fFilters) then + if (fFilters = nil) then begin fFilters := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF}; if Filter = '*.*' then @@ -24399,8 +24419,8 @@ begin FindData.dwFileAttributes, Attr ) then begin Action := diAccept; - if Assigned( OnItem ) then - OnItem( @Self, FindData, Action ); + if Assigned( OnItem ) then + OnItem( @Self, FindData, Action ); CASE Action OF diSkip: ; diAccept: @@ -24420,7 +24440,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TDirList.ScanDirectoryEx] {$IFDEF ASM_UNICODE} procedure TDirList.ScanDirectoryEx(const DirPath, Filters: AnsiString; Attr: DWord); @@ -24502,13 +24521,11 @@ type Dir : PDirList; end; -//[FUNCTION CompareDirItems] {$DEFINE CompareDirItems_ASM} {$IFNDEF ASM_VERSION} {$UNDEF CompareDirItems_ASM} {$ENDIF} {$IFDEF TLIST_FAST} {$UNDEF CompareDirItems_ASM} {$ENDIF} {$IFDEF CompareDirItems_ASM} {$DEFINE SwapDirItems_ASM} {$ENDIF} -//[PROCEDURE SwapDirItems] {$IFDEF SwapDirItems_ASM} {$ELSE ASM_VERSION} //Pascal procedure SwapDirItems( const Data : PSortDirData; const e1, e2 : DWORD ); @@ -24520,7 +24537,6 @@ begin Data.Dir.FList.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ e2 ] := Tmp; end; {$ENDIF ASM_VERSION} -//[END SwapDirItems] {always!} {$UNDEF CompareDirItems_ASM} @@ -24741,10 +24757,8 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END CompareDirItems] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TDirList.Sort(Rules: array of TSortDirRules); var SortDirData : TSortDirData; I, J : Integer; @@ -24785,7 +24799,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TDirList.FileList] function TDirList.FileList(const Separator: KOLString; Dirs, FullPaths: Boolean): KOLString; var I: Integer; @@ -24805,27 +24818,20 @@ end; // R E G I S T R Y //////////////////////////////////////////////////////////////////////// -{++}(* -function RegSetValueEx; external advapi32 name 'RegSetValueExA'; -*){--} - { -- registry -- } -//[function RegKeyOpenRead] function RegKeyOpenRead( Key: HKey; const SubKey: KOLString ): HKey; begin if RegOpenKeyEx( Key, PKOLChar( SubKey ), 0, KEY_READ, Result ) <> ERROR_SUCCESS then Result := 0; end; -//[function RegKeyOpenWrite] function RegKeyOpenWrite( Key: HKey; const SubKey: KOLString ): HKey; begin if RegOpenKeyEx( Key, PKOLChar( SubKey ), 0, KEY_READ or KEY_WRITE, Result ) <> ERROR_SUCCESS then Result := 0; end; -//[function RegKeyOpenCreate] function RegKeyOpenCreate( Key: HKey; const SubKey: KOLString ): HKey; var dwDisp: DWORD; begin @@ -24834,7 +24840,6 @@ begin Result := 0; end; -//[function RegKeyGetDw] function RegKeyGetDw( Key: HKey; const ValueName: KOLString ): DWORD; var dwType, dwSize: DWORD; begin @@ -24845,7 +24850,6 @@ begin or (dwType <> REG_DWORD) then Result := 0; end; -//[function RegKeyGetStr] function RegKeyGetStr( Key: HKey; const ValueName: KOLString ): KOLString; var dwType, dwSize: DWORD; Buffer: PKOLChar; @@ -24867,8 +24871,9 @@ begin FreeMem( Buffer ); end; -//[function RegKeyGetStrEx] -function RegKeyGetStrEx( Key: HKey; const ValueName: KOLString ): KOLString; +function RegKeyGetStrEx( Key: HKey; const ValueName: KOLString + {$IFDEF OPTIONAL_REG_EXPAND_SZ} ; ExpandEnvVars: Boolean {$ENDIF} ): +KOLString; var dwType, dwSize: DWORD; Buffer, Buffer2: PKOLChar; Sz: Integer; @@ -24886,9 +24891,11 @@ begin GetMem( Buffer, dwSize * Sizeof( KOLChar ) ); if Query then begin - if dwtype = REG_EXPAND_SZ then + if (dwtype = REG_EXPAND_SZ) {$IFDEF OPTIONAL_REG_EXPAND_SZ} and (ExpandEnvVars) {$ENDIF} then begin - Sz := ExpandEnvironmentStrings(Buffer,nil,0); // bug in size detection! sometimes we get an additional 2 bytes at the end... + Sz := ExpandEnvironmentStrings(Buffer,nil,0); + // bug in size detection! sometimes we get + // an additional 2 bytes at the end... GetMem(Buffer2,Sz * Sizeof( KOLChar )); // ExpandEnvironmentStrings(Buffer, Buffer2, Sz); // Result:=Buffer2; // @@ -24900,14 +24907,12 @@ begin FreeMem( Buffer ); end; -//[function RegKeySetDw] function RegKeySetDw( Key: HKey; const ValueName: KOLString; Value: DWORD ): Boolean; begin Result := (Key <> 0) and (RegSetValueEx( Key, PKOLChar( ValueName ), 0, REG_DWORD, @Value, sizeof( DWORD ) ) = ERROR_SUCCESS); end; -//[function RegKeySetStr] function RegKeySetStr( Key: HKey; const ValueName: KOLString; const Value: KOLString ): Boolean; begin Result := (Key <> 0) and (RegSetValueEx( Key, PKOLChar( ValueName ), 0, @@ -24915,7 +24920,6 @@ begin (Length( Value ) + 1)*Sizeof(KOLChar) ) = ERROR_SUCCESS); end; -//[function RegKeySetStrEx] function RegKeySetStrEx( Key: HKey; const ValueName: KOLString; const Value: KOLString; expand: Boolean): Boolean; var dwType: DWORD; @@ -24927,14 +24931,12 @@ begin PKOLChar(Value), (Length(Value) + 1)*Sizeof(KOLChar)) = ERROR_SUCCESS); end; -//[procedure RegKeyClose] procedure RegKeyClose( Key: HKey ); begin if Key <> 0 then RegCloseKey( Key ); end; -//[function RegKeyDelete] function RegKeyDelete( Key: HKey; const SubKey: KOLString ): Boolean; begin Result := FALSE; @@ -24942,7 +24944,6 @@ begin Result := RegDeleteKey( Key, PKOLChar( SubKey ) ) = ERROR_SUCCESS; end; -//[function RegKeyDeleteValue] function RegKeyDeleteValue( Key: HKey; const SubKey: KOLString ): Boolean; begin Result := FALSE; @@ -24950,8 +24951,7 @@ begin Result := RegDeleteValue( Key, PKOLChar( SubKey ) ) = ERROR_SUCCESS; end; -//[function RegKeyExists] -function RegKeyExists( Key: HKey; const SubKey: AnsiString ): Boolean; +function RegKeyExists( Key: HKey; const SubKey: KOLString ): Boolean; var K: Integer; begin if Key = 0 then @@ -24965,7 +24965,6 @@ begin RegKeyClose( K ); end; -//[function RegKeyValExists] function RegKeyValExists( Key: HKey; const ValueName: KOLString ): Boolean; var dwType, dwSize: DWORD; begin @@ -24974,7 +24973,6 @@ begin @dwType, nil, @dwSize ) = ERROR_SUCCESS); end; -//[function RegKeyValueSize] function RegKeyValueSize( Key: HKey; const ValueName: KOLString ): Integer; begin Result := 0; @@ -24982,7 +24980,6 @@ begin RegQueryValueEx( Key, PKOLChar( ValueName ), nil, nil, nil, @ DWORD( Result ) ); end; -//[function RegKeyGetBinary] function RegKeyGetBinary( Key: HKey; const ValueName: KOLString; var Buffer; Count: Integer ): Integer; begin Result := 0; @@ -24991,20 +24988,17 @@ begin RegQueryValueEx( Key, PKOLChar( ValueName ), nil, nil, @ Buffer, @ Result ); end; -//[function RegKeySetBinary] function RegKeySetBinary( Key: HKey; const ValueName: KOLString; const Buffer; Count: Integer ): Boolean; begin Result := (Key <> 0) and (RegSetValueEx( Key, PKOLChar( ValueName ), 0, REG_BINARY, @ Buffer, Count ) = ERROR_SUCCESS); end; -//[function RegKeyGetDateTime] function RegKeyGetDateTime(Key: HKey; const ValueName: KOLString): TDateTime; begin RegKeyGetBinary( Key, ValueName, Result, Sizeof( Result ) ); end; -//[function RegKeySetDateTime] function RegKeySetDateTime(Key: HKey; const ValueName: KOLString; DateTime: TDateTime): Boolean; begin Result := RegKeySetBinary( Key, ValueName, DateTime, Sizeof( DateTime ) ); @@ -25014,11 +25008,10 @@ end; //----------------------------------------------- // functions by Valerian Luft //----------------------------------------------- -//[function RegKeyGetSubKeys] -function RegKeyGetSubKeys( const Key: HKEY; List: PStrList) : Boolean; +function RegKeyGetSubKeys( const Key: HKEY; List: PKOLStrList) : Boolean; var I, Size, NumSubKeys, MaxSubKeyLen : DWORD; - KeyName: AnsiString; + KeyName: KOLString; begin Result := False; List.Clear ; @@ -25030,9 +25023,9 @@ nil, nil) = ERROR_SUCCESS then begin Size := MaxSubKeyLen+1; SetLength(KeyName, Size); - //FillChar(KeyName[1],Size,#0); + FillChar(KeyName[1],Size*Sizeof(KOLChar),#0); RegEnumKeyEx(Key, I, @KeyName[1], Size, nil, nil, nil, nil); - SetLength(KeyName, lstrlen(@KeyName[1])); + KeyName := Trim(KeyName); // fixed by Jon List.Add(KeyName); end; end; @@ -25053,9 +25046,9 @@ begin begin if MaxSubKeyLen > 0 then begin - GetMem(Buf,MaxSubKeyLen + 1); + Size:=MaxSubKeyLen + 1; // + GetMem(Buf,Size*Sizeof(KOLChar)); // fixed by Jon i:=0; - Size:=MaxSubKeyLen + 1; while RegEnumKeyEx(Key,i,buf,Size,nil,nil,nil,nil) <> ERROR_NO_MORE_ITEMS do begin @@ -25072,12 +25065,11 @@ begin end; {$ENDIF} -//[function RegKeyGetValueNames] {$IFDEF OLD_REGKEYGETVALUENAMES} -function RegKeyGetValueNames(const Key: HKEY; List: PStrList): Boolean; +function RegKeyGetValueNames(const Key: HKEY; List: PKOLStrList): Boolean; var I, Size, NumSubKeys, NumValueNames, MaxValueNameLen: DWORD; - ValueName: AnsiString; + ValueName: KOLString; begin List.Clear ; Result:=False; @@ -25088,9 +25080,9 @@ begin for I := 0 to NumValueNames - 1 do begin Size := MaxValueNameLen + 1; SetLength(ValueName, Size); - //FillChar(ValueName[1],Size,#0); + FillChar(ValueName[1],Size,#0); RegEnumValue(Key, I, @ValueName[1], Size, nil, nil, nil, nil); - SetLength(ValueName, lstrlen(@ValueName[1])); + ValueName := Trim(ValueName); List.Add(ValueName); end; Result := True; @@ -25110,13 +25102,12 @@ begin begin if MaxValueNameLen > 0 then begin - GetMem(Buf,MaxValueNameLen + SizeOf(KOLChar) ); - i:=0; Size:=MaxValueNameLen+1; - + GetMem(Buf,Size * SizeOf(KOLChar) ); + i:=0; while RegEnumValue(Key,i,buf,Size,nil,nil,nil,nil) <> ERROR_NO_MORE_ITEMS do begin - List.Add(KOLString(Buf)); + List.Add(KOLString(Buf)); Size:=MaxValueNameLen+1; inc(i); end; @@ -25129,7 +25120,6 @@ begin end; {$ENDIF} -//[function RegKeyGetValueTyp] function RegKeyGetValueTyp (const Key:HKEY; const ValueName: KOLString) : DWORD; begin Result:= Key ; @@ -25148,7 +25138,6 @@ end; but it is based on 31-Dec-0000 instead, allowing easy manipulating of dates at all Christian era, and all other historical era too. } -//[procedure DivMod] procedure DivMod(Dividend: Integer; Divisor: Word; var Result, Remainder: Word); {$IFDEF F_P} begin @@ -25169,14 +25158,6 @@ asm end; {$ENDIF} -{++}(* -//[API GetLocalTime, GetSystemTime] -procedure GetLocalTime; external kernel32 name 'GetLocalTime'; -procedure GetSystemTime; external kernel32 name 'GetSystemTime'; -*){--} - -//* -//[function Now] function Now : TDateTime; var SystemTime : TSystemTime; begin @@ -25184,13 +25165,11 @@ begin SystemTime2DateTime( SystemTime, Result ); end; -//[function Date] function Date: TDateTime; begin Result := Trunc( Now ); end; -//[procedure DecodeDateFully] procedure DecodeDateFully( DateTime: TDateTime; var Year, Month, Day, DayOfWeek: WORD ); var ST: TSystemTime; begin @@ -25201,14 +25180,12 @@ begin DayOfWeek := ST.wDayOfWeek; end; -//[procedure DecodeDate] procedure DecodeDate( DateTime: TDateTime; var Year, Month, Day: WORD ); var Dummy: Word; begin DecodeDateFully( DateTime, Year, Month, Day, Dummy ); end; -//[function EncodeDate] function EncodeDate( Year, Month, Day: WORD; var DateTime: TDateTime ): Boolean; var ST: TSystemTime; begin @@ -25219,7 +25196,6 @@ begin Result := SystemTime2DateTime( ST, DateTime ); end; -//[procedure IncDays] procedure IncDays( var SystemTime : TSystemTime; DaysNum : Integer ); var DateTime : TDateTime; begin @@ -25228,8 +25204,6 @@ begin DateTime2SystemTime( DateTime, SystemTime ); end; -//* -//[procedure IncMonths] procedure IncMonths( var SystemTime : TSystemTime; MonthsNum : Integer ); var M : Integer; DateTime : TDateTime; @@ -25243,15 +25217,11 @@ begin DateTime2SystemTime( DateTime, SystemTime ); end; -//* -//[function IsLeapYear] function IsLeapYear(Year: Integer): Boolean; begin Result := (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0)); end; -//* -//[function SystemTime2DateTime] function SystemTime2DateTime(const SystemTime : TSystemTime; var DateTime : TDateTime ) : Boolean; var I : Integer; _Day : Integer; @@ -25281,15 +25251,11 @@ begin end; end; -//* -//[function DayOfWeek] function DayOfWeek(Date: TDateTime): Integer; begin Result := (Trunc( Date ) + 6) mod 7 + 1; end; -//* -//[function DateTime2SystemTime] function DateTime2SystemTime(const DateTime : TDateTime; var SystemTime : TSystemTime ) : Boolean; const D1 = 365; @@ -25365,13 +25331,11 @@ begin Result := D2 - D1; end; -//[function DateTime_System2Local] function DateTime_System2Local( DTSys: TDateTime ): TDateTime; begin Result := DTSys + DateTime_DiffSysLoc; end; -//[function DateTime_Local2System] function DateTime_Local2System( DTLoc: TDateTime ): TDateTime; begin Result := DTLoc - DateTime_DiffSysLoc; @@ -25394,8 +25358,6 @@ begin LocalFileTimeToFileTime( ft, ft ); end; -//* -//[function SystemDate2Str] function SystemDate2Str( const SystemTime : TSystemTime; const LocaleID : DWORD; const DfltDateFormat : TDateFormat; const DateFormat : PKOLChar ) : KOLString; @@ -25436,8 +25398,6 @@ begin FreeMem( Buf ); end; -//* -//[function SystemTime2Str] function SystemTime2Str( const SystemTime : TSystemTime; const LocaleID : DWORD; const Flags : TTimeFormatFlags; const TimeFormat : PKOLChar ) : KOLString; @@ -25482,7 +25442,6 @@ begin FreeMem( Buf ); end; -//[function Date2StrFmt] function Date2StrFmt( const Fmt: KOLString; D: TDateTime ): KOLString; var ST: TSystemTime; lpFmt: PKOLChar; @@ -25493,7 +25452,6 @@ begin Result := SystemDate2Str( ST, LOCALE_USER_DEFAULT, dfShortDate, lpFmt ); end; -//[function Time2StrFmt] function Time2StrFmt( const Fmt: KOLString; D: TDateTime ): KOLString; var ST: TSystemTime; lpFmt: PKOLChar; @@ -25505,7 +25463,6 @@ begin Result := SystemTime2Str( ST, LOCALE_USER_DEFAULT, [], lpFmt ); end; -//[function DateTime2StrShort] function DateTime2StrShort( D: TDateTime ): KOLString; var ST: TSystemTime; begin @@ -25517,7 +25474,6 @@ begin SystemTime2Str( ST, LOCALE_USER_DEFAULT {GetUserDefaultLCID}, [], nil ); end; -//[function Str2DateTimeFmt] function Str2DateTimeFmt( const sFmtStr, sS: KOLString ): TDateTime; var h12, hAM: Boolean; FmtStr, S: PKOLChar; @@ -25548,7 +25504,7 @@ var h12, hAM: Boolean; begin Result := GetNum( S, NChars ); GetSystemTime( STNow ); - OldDate := Result < 50; + OldDate := (Result >= 50) and (Result < 100); Result := Result + STNow.wYear - STNow.wYear mod 100; if OldDate then Dec( Result, 100 ); end; @@ -25696,7 +25652,6 @@ end; var FmtBuf: PKOLChar; DateSeparator : KOLChar = #0; // + ECM -//[function Str2DateTimeShort] function Str2DateTimeShort( const S: KOLString ): TDateTime; var FmtStr, FmtStr2: KOLString; @@ -25732,7 +25687,6 @@ begin end; // + ECM -//[function Str2DateTimeShortEx] function Str2DateTimeShortEx( const S: KOLString ): TDateTime; var St: KOLString; Buff: Array[0..1] of KOLChar; @@ -25754,31 +25708,30 @@ end; { -- Thread -- } -//[function ThreadFunc] function ThreadFunc(Thread: PThread): integer; stdcall; begin Result := Thread.Execute; end; {$IFDEF USE_CONSTRUCTORS} -//[function NewThread] function NewThread: PThread; begin new( Result, ThreadCreate ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TThread'; + {$ENDIF} end; -//[END NewThread] {$ELSE not_USE_CONSTRUCTORS} -//* -//[function NewThread] + function NewThread: PThread; begin {$IFNDEF FPC105ORBELOW} IsMultiThread := True; {$ENDIF} - {-} New( Result, Create ); - {+} - {++}(*Result := PThread.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TThread'; + {$ENDIF} Result.FSuspended := True; {$IFDEF PSEUDO_THREADS} {$ELSE} @@ -25790,18 +25743,18 @@ begin Result.FThreadID ); // receive thread ID {$ENDIF} end; -//[END NewThread] {$ENDIF USE_CONSTRUCTORS} {$IFDEF USE_CONSTRUCTORS} -//[function NewThreadEx] function NewThreadEx( const Proc: TOnThreadExecute ): PThread; begin new( Result, ThreadCreateEx( Proc ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TThreadEx'; + {$ENDIF} end; {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewThreadEx] {$IFDEF ASM_!VERSION} function NewThreadEx( const Proc: TOnThreadExecute ): PThread; asm @@ -25822,22 +25775,22 @@ end; function NewThreadEx( const Proc: TOnThreadExecute ): PThread; begin Result := NewThread; - Result.OnExecute := {++}(*{$IFDEF F_P} @ {$ENDIF}*){--}Proc; + Result.OnExecute := Proc; Result.Resume; end; {$ENDIF ASM_VERSION} -//[END NewThreadEx] {$ENDIF USE_CONSTRUCTORS} -//[function NewThreadAutoFree] function NewThreadAutoFree( const Proc: TOnThreadExecute ): PThread; begin Result := NewThread; - Result.OnExecute := {++}(*{$IFDEF F_P} @ {$ENDIF}*){--}Proc; + Result.OnExecute := Proc; Result.F_AutoFree := TRUE; - if Assigned( Proc ) then - Result.Resume; + {$IFDEF SAFE_CODE} + if Assigned( Proc ) then + {$ENDIF} + Result.Resume; end; { TThread } @@ -25868,7 +25821,7 @@ external 'winmm.dll' name 'timeEndPeriod'; procedure TThread.Init; begin - {$IFDEF _D2orD3} + {$IFDEF CALL_INHERITED} inherited; {$ENDIF} if Applet <> nil then @@ -25878,6 +25831,9 @@ begin begin // creating main thread CreatingMainThread := TRUE; new( MainThread, Create ); + {$IFDEF DEBUG_OBJKIND} + MainThread.fObjKind := 'MainThread'; + {$ENDIF} CreatingMainThread := FALSE; end; if CreatingMainThread then @@ -25897,9 +25853,7 @@ begin {$ENDIF} end; -//[destructor TThread.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TThread.Destroy; begin RefInc; @@ -25930,21 +25884,25 @@ begin end; {$ENDIF ASM_VERSION} -//* -//[function TThread.Execute] function TThread.Execute: integer; +//var H: THandle; begin + {$IFDEF SAFE_CODE} Result := 0; - if Assigned( FOnExecute ) then - Result := FOnExecute( @Self ); + if Assigned( FOnExecute ) then + {$ENDIF} + Result := FOnExecute( @Self ); FResult := Result; FTerminated := TRUE; // fake thread object (to prevent terminating while freeing) if F_AutoFree then - Free; + begin +// H := FHandle; +// FHandle := 0; + Free; +// TerminateThread( H, 0 ); + end; end; -//* -//[function TThread.GetPriorityCls] function TThread.GetPriorityCls: Integer; begin {$IFDEF PSEUDO_THREADS} @@ -25954,8 +25912,6 @@ begin {$ENDIF} end; -//* -//[function TThread.GetThrdPriority] function TThread.GetThrdPriority: Integer; begin {$IFDEF PSEUDO_THREADS} @@ -25965,26 +25921,22 @@ begin {$ENDIF} end; -//* -//[procedure TThread.Resume] procedure TThread.Resume; begin {$IFDEF PSEUDO_THREADS} - if MainThread.CurrentThread = @ Self then - Exit; - MainThread.SwitchToThread( @ Self ); + if MainThread.CurrentThread = @ Self then + Exit; + MainThread.SwitchToThread( @ Self ); {$ELSE} - FSuspended := False; - if (ResumeThread(FHandle) > 1) then - FSuspended := True - else - if Assigned(FOnResume) then - FOnResume(@Self); + FSuspended := False; + if (ResumeThread(FHandle) > 1) then + FSuspended := True + else + if Assigned(FOnResume) then + FOnResume(@Self); {$ENDIF} end; -//* -//[procedure TThread.SetPriorityCls] procedure TThread.SetPriorityCls(Value: Integer); begin {$IFDEF DEBUG} @@ -26001,8 +25953,6 @@ begin {$ENDIF} end; -//* -//[procedure TThread.SetThrdPriority] procedure TThread.SetThrdPriority(Value: Integer); begin FPriority := Value; @@ -26012,20 +25962,18 @@ begin {$ENDIF} end; -//* -//[procedure TThread.Suspend] procedure TThread.Suspend; begin {$IFDEF PSEUDO_THREADS} - if MainThread <> @ Self then - FSuspended := TRUE; - if MainThread.CurrentThread = @ Self then - MainThread.NextThread; + if MainThread <> @ Self then + FSuspended := TRUE; + if MainThread.CurrentThread = @ Self then + MainThread.NextThread; {$ELSE} - FSuspended := TRUE; - if Assigned(FOnSuspend) then - Synchronize( FOnSuspend ); - SuspendThread(FHandle); + FSuspended := TRUE; + if Assigned(FOnSuspend) then + Synchronize( FOnSuspend ); + SuspendThread(FHandle); {$ENDIF} end; @@ -26039,7 +25987,11 @@ end; procedure TThread.SwitchToThread(T: PThread); begin - if (T <> MainThread) and not Assigned( T.OnExecute ) then Exit; + {$IFDEF SAFE_CODE} + if (T <> MainThread) + and not Assigned( T.OnExecute ) + then Exit; + {$ENDIF} if Assigned( MainThread.CurrentThread.OnSuspend ) then begin MainThread.CurrentThread.OnExecute( MainThread.CurrentThread ); @@ -26113,7 +26065,10 @@ begin T := MainThread.AllThreads.Items[ i ]; if (T.DoNotWakeUntil > C) and (T <> MainThread) then continue; if (T = MainThread) and (MainThread.CurrentThread = T) then Exit; - if not T.Terminated and not ((T <> MainThread) and (T.Suspended)) then break; + if not T.Terminated and not ((T <> MainThread) and (T.Suspended)) then + begin + break; + end; end; MainThread.SwitchToThread( MainThread.AllThreads.Items[ i ] ); end; @@ -26182,8 +26137,6 @@ begin end; {$ENDIF PSEUDO_THREADS} -//* -//[procedure TThread.Synchronize] procedure TThread.Synchronize(Method: TThreadMethod); begin {$IFDEF PSEUDO_THREADS} @@ -26195,7 +26148,6 @@ begin {$ENDIF} end; -//[procedure TThread.SynchronizeEx] procedure TThread.SynchronizeEx( Method: TThreadMethodEx; Param: Pointer ); begin Assert( Param <> nil, 'Parameter must not be NIL' ); @@ -26207,23 +26159,19 @@ begin {$ENDIF} end; -//* -//[procedure TThread.Terminate] procedure TThread.Terminate; begin {$IFDEF PSEUDO_THREADS} - FTerminated := TRUE; - if Assigned( MainThread ) then - if MainThread.CurrentThread = @ Self then - MainThread.NextThread; + FTerminated := TRUE; + if Assigned( MainThread ) then + if MainThread.CurrentThread = @ Self then + MainThread.NextThread; {$ELSE} - TerminateThread(FHandle,0); - FTerminated := True; + TerminateThread(FHandle,0); + FTerminated := True; {$ENDIF} end; -//* -//[function TThread.WaitFor] function TThread.WaitFor: Integer; begin RefInc; @@ -26288,9 +26236,11 @@ begin begin M := GetModuleHandle( 'kernel32' ); GPB := GetProcAddress( M, 'GetThreadPriorityBoost' ); - if Assigned( GPB ) then - if GPB( fHandle, B ) then - Result := B; + {$IFDEF SAFE_CODE} + if Assigned( GPB ) then + {$ENDIF} + if GPB( fHandle, B ) then + Result := B; end; end; @@ -26305,8 +26255,10 @@ begin begin M := GetModuleHandle( 'kernel32' ); SPB := GetProcAddress( M, 'SetThreadPriorityBoost' ); - if Assigned( SPB ) then - SPB( fHandle, not Value ); + {$IFDEF SAFE_CODE} + if Assigned( SPB ) then + {$ENDIF} + SPB( fHandle, not Value ); end; end; @@ -26324,19 +26276,16 @@ end; your own data of any type (but do not forget to define correct releasing of such data in your fClose procedure). } -//[function TStream.GetPosition] function TStream.GetPosition: TStrmSize; begin Result := Seek( 0, spCurrent ); end; -//[procedure TStream.SetPosition] procedure TStream.SetPosition(const Value: TStrmSize); begin Seek( Value, spBegin ); end; -//[function TStream.GetSize] {$IFDEF ASM_STREAM} function TStream.GetSize: TStrmSize; asm @@ -26349,7 +26298,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStream.SetSize] {$IFDEF ASM_STREAM} procedure TStream.SetSize(const NewSize: TStrmSize); asm @@ -26362,13 +26310,11 @@ begin end; {$ENDIF ASM_VERSION} -//[function TStream.GetFileStreamHandle] function TStream.GetFileStreamHandle: THandle; begin Result := fData.fHandle; end; -//[function TStream.Read] {$IFDEF ASM_STREAM} function TStream.Read(var Buffer; const Count: TStrmSize): TStrmSize; asm @@ -26381,13 +26327,11 @@ begin end; {$ENDIF ASM_VERSION} -//[function TStream.GetCapacity] function TStream.GetCapacity: TStrmSize; begin Result := fData.fCapacity; end; -//[procedure TStream.SetCapacity] procedure TStream.SetCapacity(const Value: TStrmSize); var OldSize: DWORD; V: TStrmSize; @@ -26419,13 +26363,11 @@ begin {$ENDIF} end; -//[function TStream.Busy] function TStream.Busy: Boolean; begin - Result := Assigned( fData.fThread ); + Result := ( fData.fThread <> nil ); end; -//[function TStream.DoAsyncRead] function TStream.DoAsyncRead( Sender: PThread ): Integer; begin Read( Pointer( fParam1 )^, fParam2 ); @@ -26433,7 +26375,6 @@ begin Result := 0; end; -//[procedure TStream.ReadAsync] procedure TStream.ReadAsync(var Buffer; Count: DWord); begin if Busy then Wait; @@ -26444,7 +26385,6 @@ begin fData.fThread.Resume; end; -//[function TStream.DoAsyncSeek] function TStream.DoAsyncSeek( Sender: PThread ): Integer; begin Seek( fParam1, TMoveMethod( fParam2 ) ); @@ -26452,7 +26392,6 @@ begin Result := 0; end; -//[procedure TStream.SeekAsync] procedure TStream.SeekAsync(MoveTo: TStrmMove; MoveMethod: TMoveMethod); begin if Busy then Wait; @@ -26463,7 +26402,6 @@ begin fData.fThread.Resume; end; -//[function TStream.DoAsyncWrite] function TStream.DoAsyncWrite( Sender: PThread ): Integer; begin Write( Pointer( fParam1 )^, fParam2 ); @@ -26471,7 +26409,6 @@ begin Result := 0; end; -//[procedure TStream.WriteAsync] procedure TStream.WriteAsync(var Buffer; Count: DWord); begin if Busy then Wait; @@ -26482,17 +26419,15 @@ begin fData.fThread.Resume; end; -//[procedure TStream.Wait] procedure TStream.Wait; begin - if not Assigned( fData.fThread ) then Exit; - if Assigned( fMethods.fWait ) then - fMethods.fWait( @Self ) + if ( fData.fThread = nil ) then Exit; + if Assigned( fMethods.fWait ) then + fMethods.fWait( @Self ) else - fData.fThread.WaitFor; + fData.fThread.WaitFor; end; -//[function TStream.Write] {$IFDEF ASM_STREAM} function TStream.Write(var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize): TStrmSize; asm @@ -26505,13 +26440,11 @@ begin end; {$ENDIF ASM_VERSION} -//[function TStream.WriteVal] function TStream.WriteVal(Value, Count: DWORD): DWORD; begin Result := Write( Value, Count ); end; -//[function TStream.WriteStr] function TStream.WriteStr(S: AnsiString): DWORD; begin if S <> '' then @@ -26520,7 +26453,6 @@ begin Result := 0; end; -//[function TStream.ReadStrZ] function TStream.ReadStrZ: AnsiString; var C: AnsiChar; begin @@ -26551,7 +26483,6 @@ begin end; {$ENDIF _D3orHigher} -//[function TStream.ReadStr] function TStream.ReadStr: AnsiString; var C: AnsiChar; begin @@ -26577,7 +26508,6 @@ begin UNTIL C in [ #13, #0 ]; end; -//[function TStream.ReadStrLen] function TStream.ReadStrLen(Len: Integer): AnsiString; var i: Integer; begin @@ -26586,7 +26516,6 @@ begin SetLength( Result, i ); end; -//[function TStream.WriteStrZ] function TStream.WriteStrZ(S: AnsiString): DWORD; var C: AnsiChar; begin @@ -26613,7 +26542,6 @@ begin end; {$ENDIF _D3orHigher} -//[function TStream.WriteStrEx] function TStream.WriteStrEx(S: AnsiString): DWord; var L: DWORD; begin @@ -26623,7 +26551,6 @@ begin Inc( result, fmethods.fwrite(@self,s[1],L) ); end; -//[function TStream.ReadStrExVar] function TStream.ReadStrExVar(var S: AnsiString): DWord; begin fmethods.fread(@self,result,Sizeof(DWORD)); @@ -26631,13 +26558,11 @@ begin if result<>0 then result:=fmethods.fread(@self,s[1],result); end; -//[function TStream.ReadStrEx] function TStream.ReadStrEx: AnsiString; begin readstrexvar(result); end; -//[function TStream.WriteStrPas] function TStream.WriteStrPas( S: AnsiString ): DWORD; var L: Integer; begin @@ -26650,7 +26575,6 @@ begin Result := Write( S[ 1 ], L ) + 1; end; -//[function TStream.ReadStrPas] function TStream.ReadStrPas: AnsiString; var L: Byte; begin @@ -26661,7 +26585,6 @@ begin Result := Copy( Result, 1, L ); end; -//[function TStream.Seek] {$IFDEF ASM_STREAM} function TStream.Seek({$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveMethod: TMoveMethod): TStrmSize; //function TStream.Seek(MoveTo: TStrmMove; MoveMethod: TMoveMethod): TStrmSize; @@ -26675,9 +26598,7 @@ begin end; {$ENDIF ASM_VERSION} -//[destructor TStream.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TStream.Destroy; begin fMethods.fClose( @Self ); @@ -26699,18 +26620,18 @@ begin end; //+- -//[function _NewStream] function _NewStream( const StreamMethods: TStreamMethods ): PStream; begin - {-} New( Result, Create ); - {+}{++}(*Result := PStream.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TStream'; + {$ENDIF} Move( StreamMethods, Result.fMethods, Sizeof( TStreamMethods ) ); Result.fPMethods := @Result.fMethods; + TMethod( Result.fOnChangePos ).Code := @DummyObjProc; end; //+ -//[function SeekFileStream] function SeekFileStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize; begin Result := FileSeek( Strm.fData.fHandle, MoveTo, MoveFrom ); @@ -26720,7 +26641,6 @@ begin end; //+ -//[function GetSizeFileStream] function GetSizeFileStream( Strm: PStream ): TStrmSize; {$IFDEF STREAM_LARGE64} var SizeHigh: DWORD; @@ -26735,23 +26655,19 @@ begin {$ENDIF} end; -//[procedure DummySetSize] procedure DummySetSize( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Value: TStrmSize ); begin end; -//[procedure DummyStreamProc] procedure DummyStreamProc(Strm: PStream); begin end; -//[function DummyReadWrite] function DummyReadWrite( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; asm XOR EAX, EAX end; -//[function ReadFileStream] function ReadFileStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; begin Result := FileRead( Strm.fData.fHandle, Buffer, Count ); @@ -26764,11 +26680,11 @@ function ReadFileStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COM begin Result := FileRead( Strm.fData.fHandle, Buffer, Count ); inc( Strm.fData.fPosition, Result ); - if (Result > 0) and Assigned( Strm.OnChangePos ) then - Strm.OnChangePos( Strm ); + if (Result > 0) + {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then + Strm.OnChangePos( Strm ); end; -//[function WriteFileStream] function WriteFileStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; begin Result := FileWrite( Strm.fData.fHandle, Buffer, Count ); @@ -26781,11 +26697,11 @@ function WriteFileStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_CO begin Result := FileWrite( Strm.fData.fHandle, Buffer, Count ); inc( Strm.fData.fPosition, Result ); - if (Result > 0) and Assigned( Strm.OnChangePos ) then + if (Result > 0) + {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then Strm.OnChangePos( Strm ); end; -//[FUNCTION WriteFileStreamEOF] {$IFDEF ASM_STREAM} function WriteFileStreamEOF( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; asm @@ -26807,18 +26723,17 @@ begin SetEndOfFile( Strm.fData.fHandle ); end; {$ENDIF ASM_VERSION} -//[END WriteFileStreamEOF] function WriteFileStreamEOFWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; begin Result := WriteFileStream( Strm, Buffer, Count ); inc( Strm.fData.fPosition, Result ); SetEndOfFile( Strm.fData.fHandle ); - if (Result > 0) and Assigned( Strm.OnChangePos ) then - Strm.OnChangePos( Strm ); + if (Result > 0) + {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then + Strm.OnChangePos( Strm ); end; -//[procedure CloseFileStream] procedure CloseFileStream( Strm: PStream ); begin if Strm.fData.fHandle <> INVALID_HANDLE_VALUE then @@ -26826,7 +26741,6 @@ begin Strm.fData.fHandle := INVALID_HANDLE_VALUE; end; -//[FUNCTION SeekMemStream] {$IFDEF ASM_STREAM} function SeekMemStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize; @@ -26868,24 +26782,22 @@ begin Result := NewPos; end; {$ENDIF ASM_VERSION} -//[END SeekMemStream] function SeekMemStreamWithEvent( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} MoveTo: TStrmMove; MoveFrom: TMoveMethod ): TStrmSize; var OldPos: DWORD; begin OldPos := Strm.Position; Result := SeekMemStream( Strm, MoveTo, MoveFrom ); - if (OldPos <> Strm.Position) and Assigned( Strm.OnChangePos ) then - Strm.OnChangePos( Strm ); + if (OldPos <> Strm.Position) + {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then + Strm.OnChangePos( Strm ); end; -//[function GetSizeMemStream] function GetSizeMemStream( Strm: PStream ): TStrmSize; begin Result := Strm.fData.fSize; end; -//[PROCEDURE SetSizeMemStream] {$IFDEF ASM_STREAM} procedure SetSizeMemStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize ); asm @@ -26974,9 +26886,7 @@ begin S.fData.fPosition := S.fData.fSize; end; {$ENDIF ASM_VERSION} -//[END SetSizeMemStream] -//[FUNCTION ReadMemStream] {$IFDEF ASM_STREAM} function ReadMemStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; asm @@ -27011,16 +26921,15 @@ begin Inc( S.fData.fPosition, Result ); end; {$ENDIF ASM_VERSION} -//[END ReadMemStream] function ReadMemStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; begin Result := ReadMemStream( Strm, Buffer, Count ); - if (Result > 0) and Assigned( Strm.OnChangePos ) then - Strm.OnChangePos( Strm ); + if (Result > 0) + {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then + Strm.OnChangePos( Strm ); end; -//[FUNCTION WriteMemStream] {$IFDEF ASM_STREAM} function WriteMemStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; asm @@ -27058,18 +26967,16 @@ begin Inc( S.fData.fPosition, Result ); end; {$ENDIF ASM_VERSION} -//[END WriteMemStream] function WriteMemStreamWithEvent( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; begin Result := WriteMemStream( Strm, Buffer, Count ); - if (Result > 0) and Assigned( Strm.OnChangePos ) then - Strm.OnChangePos( Strm ); + if (Result > 0) + {$IFDEF SAFE_CODE} and Assigned( Strm.OnChangePos ) {$ENDIF} then + Strm.OnChangePos( Strm ); end; -//[PROCEDURE CloseMemStream] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure CloseMemStream( Strm: PStream ); var S: PStream; begin @@ -27081,7 +26988,6 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END CloseMemStream] procedure DummyCloseStream( Strm: PStream ); begin @@ -27089,7 +26995,6 @@ begin end; // by Roman Vorobets: -//[procedure SetSizeFileStream] procedure SetSizeFileStream( Strm: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} NewSize: TStrmSize ); var P: DWORD; @@ -27250,7 +27155,6 @@ begin end; -//[function NewFileStream] function NewFileStream( const FileName: KOLString; Options: DWORD ): PStream; begin Result := _NewStream( BaseFileMethods ); @@ -27269,9 +27173,7 @@ begin Result.fData.fHandle := FileCreate( FileName, Options ); end; -//[FUNCTION NewReadFileStream] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewReadFileStream( const FileName: KOLString ): PStream; begin Result := _NewStream( BaseFileMethods ); @@ -27280,7 +27182,6 @@ begin ofOpenRead or ofShareDenyWrite or ofOpenExisting ); end; {$ENDIF ASM_VERSION} -//[END NewReadFileStream] function NewReadFileStreamWithEvent( const FileName: KOLString ): PStream; begin @@ -27309,9 +27210,7 @@ begin end; {$ENDIF _D3orHigher} -//[FUNCTION NewWriteFileStream] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewWriteFileStream( const FileName: KOLString ): PStream; begin Result := _NewStream( BaseFileMethods ); @@ -27321,7 +27220,6 @@ begin ofOpenWrite or ofCreateAlways or ofShareDenyWrite ); end; {$ENDIF ASM_VERSION} -//[END NewWriteFileStream] function NewWriteFileStreamWithEvent( const FileName: KOLString ): PStream; begin @@ -27343,7 +27241,6 @@ begin end; {$ENDIF _D3orHigher} -//[FUNCTION NewReadWriteFileStream] {$IFDEF ASM_noVERSION} function NewReadWriteFileStream( const FileName: AnsiString ): PStream; asm @@ -27382,7 +27279,6 @@ begin ofOpenReadWrite or Creation or ofShareDenyWrite ); end; {$ENDIF ASM_VERSION} -//[END NewReadWriteFileStream] {$IFDEF _D3orHigher} function NewReadWriteFileStreamW( const FileName: WideString ): PStream; @@ -27399,7 +27295,6 @@ begin end; {$ENDIF _D3orHigher} -//[function NewMemoryStream] function NewMemoryStream: PStream; begin Result := _NewStream( MemoryMethods ); @@ -27412,7 +27307,6 @@ begin Result.fMethods.fWrite := WriteMemStreamWithEvent; end; -//[FUNCTION WriteExMemoryStream] {$IFDEF ASM_STREAM} function WriteExMemoryStream( Strm: PStream; var Buffer; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; asm @@ -27455,15 +27349,12 @@ begin Inc( S.fData.fPosition, Result ); end; {$ENDIF ASM_VERSION} -//[END WriteExMemoryStream] -//[procedure DummyClose_ExMemStream] procedure DummyClose_ExMemStream( Strm: PStream ); begin // nothing to do - ignore call (memory is not released by any way) end; -//[function NewExMemoryStream] function NewExMemoryStream( ExistingMem: Pointer; Size: DWORD ): PStream; begin Result := NewMemoryStream; @@ -27494,8 +27385,6 @@ begin Result.Add2AutoFree( BaseStream ); end; -//* -//[function Stream2Stream] function Stream2Stream( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; var Buf: Pointer; C: TStrmSize; @@ -27527,13 +27416,11 @@ begin end; end; -//[function Stream2StreamEx] function Stream2StreamEx( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize ): TStrmSize; begin Result := Stream2StreamExBufSz( Dst, Src, Count, 65536 ); end; -//[function Stream2StreamExBufSz] function Stream2StreamExBufSz( Dst, Src: PStream; {$IFNDEF STREAM_COMPAT} const {$ENDIF} Count: TStrmSize; BufSz: DWORD ): TStrmSize; var buf:pointer; @@ -27558,7 +27445,6 @@ begin end; end; -//[FUNCTION Resource2Stream] {$IFDEF ASM_UNICODE} {$IFNDEF STREAM_LARGE64} {$DEFINE ASM_Resource2Stream} @@ -27665,7 +27551,6 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END Resource2Stream] /////////////////////////////////////////////////////////////////////////// // I N I - F I L E S @@ -27673,9 +27558,7 @@ end; { TIniFile } -//[destructor TIniFile.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TIniFile.Destroy; begin fFileName := ''; @@ -27687,29 +27570,24 @@ end; {$IFNDEF _D5orHigher} // Place here correct definition for WritePrivateProfileStruct // and GetPrivateProfileStruct (a bug in Delphi2, Delphi3 and Delphi4) -//[API WritePrivateProfileStruct] //dufa {function WritePrivateProfileStruct(lpszSection, lpszKey: PAnsiChar; lpStruct: Pointer; uSizeStruct: UINT; szFile: PAnsiChar): BOOL; stdcall; external kernel32 name 'WritePrivateProfileStructA'; -//[API GetPrivateProfileStruct] function GetPrivateProfileStruct(lpszSection, lpszKey: PAnsiChar; lpStruct: Pointer; uSizeStruct: UINT; szFile: PAnsiChar): BOOL; stdcall; external kernel32 name 'GetPrivateProfileStructA';} // + by Slava A. Gavrik: //////////////////////////////////////////////////////////////////////////// -//[function WritePrivateProfileSection] //dufa {function WritePrivateProfileSection(lpAppName, lpString, lpFileName: PAnsiChar): BOOL; stdcall; external kernel32 name 'WritePrivateProfileSectionA'; -//[function GetPrivateProfileSection] function GetPrivateProfileSection(lpAppName: PAnsiChar; lpReturnedString: PAnsiChar; nSize: DWORD; lpFileName: PAnsiChar): DWORD; stdcall; external kernel32 name 'GetPrivateProfileSectionA'; -//[function GetPrivateProfileSectionNames] function GetPrivateProfileSectionNames(lpszReturnBuffer: PAnsiChar; nSize: DWORD; lpFileName: PAnsiChar): DWORD; stdcall; @@ -27717,28 +27595,24 @@ DWORD; //////////////////////////////////////////////////////////////////////////// {$ENDIF} -//[procedure TIniFile.ClearAll] procedure TIniFile.ClearAll; begin WritePrivateProfileString( nil, nil, nil, PKOLChar( fFileName ) ); end; -//[procedure TIniFile.ClearKey] procedure TIniFile.ClearKey(const Key: KOLString); begin WritePrivateProfileString( PKOLChar( fSection ), PKOLChar( Key ), nil, PKOLChar( fFileName ) ); end; -//[procedure TIniFile.ClearSection] procedure TIniFile.ClearSection; begin WritePrivateProfileString( PKOLChar( fSection ), nil, nil, PKOLChar( fFileName ) ); end; -//[function TIniFile.ValueBoolean] function TIniFile.ValueBoolean(const Key: KOLString; Value: Boolean): Boolean; begin if fMode = ifmRead then @@ -27753,7 +27627,6 @@ begin end; end; -//[function TIniFile.ValueData] function TIniFile.ValueData(const Key: KOLString; Value: Pointer; Count: Integer): Boolean; begin @@ -27765,7 +27638,6 @@ begin Value, Count, PKOLChar( fFileName ) ); end; -//[function TIniFile.ValueInteger] function TIniFile.ValueInteger(const Key: KOLString; Value: Integer): Integer; begin if fMode = ifmRead then @@ -27779,7 +27651,6 @@ begin end; end; -//[function TIniFile.ValueString] function TIniFile.ValueString(const Key, Value: KOLString): KOLString; var Buffer: array[0..4095] of KOLChar; @@ -27807,12 +27678,12 @@ begin Result := Str2Double( ValueString( Key, Double2Str( Value ) ) ); end; -//[function OpenIniFile] function OpenIniFile( const FileName: KOLString ): PIniFile; begin - {-} New( Result, Create ); - {+}{++}(*Result := PIniFile.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TIniFile'; + {$ENDIF} Result.fFileName := FileName; end; @@ -27823,7 +27694,6 @@ const IniBufferSize = 32767; IniBufferStrSize = IniBufferSize+4; /// для махинаций :) -//[procedure TIniFile.GetSectionNames] {$IFDEF ASM_UNICODE} procedure _FillStrList; // Эта часть кода общая для двух следующих процедур asm @@ -28006,7 +27876,6 @@ begin FreeMem(Buffer); end; -//[procedure TIniFile.SectionData] procedure TIniFile.SectionData(Names: PKOLStrList); var i:integer; @@ -28048,18 +27917,14 @@ end; { -- Menu implementation -- } -//[FUNCTION MakeAccelerator] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function MakeAccelerator( fVirt: Byte; Key: Word ): TMenuAccelerator; begin Result.fVirt := fVirt; Result.Key := Key; end; {$ENDIF ASM_VERSION} -//[END MakeAccelerator] -//[FUNCTION GetAcceleratorText] function GetAcceleratorText( const Accelerator: TMenuAccelerator ): KOLString; var KeyName: array[0..255] of KOLChar; @@ -28092,13 +27957,12 @@ begin AddKeyName(Key); end; end; -//[END GetAcceleratorText] const MIDATA_CHECKITEM = $40000000; MIDATA_RADIOITEM = $80000000; -//[function WndProcMenu] + {$IFNDEF NEW_MENU_ACCELL} function WndProcMenu( Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; var M, M1: PMenu; @@ -28110,35 +27974,35 @@ begin begin if (Msg.lParam = 0) and (HIWORD( Msg.wParam ) <= 1) then begin - M := PMenu( Sender.fMenuObj ); - while (M = nil) and (Sender.Parent <> nil) do - begin - Sender := Sender.Parent; M := PMenu( Sender.fMenuObj ); - end; - while M <> nil do - begin - Id := LoWord( Msg.wParam ); - M1 := M.Items[ Id ]; - if M1 <> nil then + while (M = nil) and (Sender.Parent <> nil) do begin - Result := True; - Rslt := 0; - Idx := M.IndexOf( M1 ); - M.fByAccel := HiWord( Msg.wParam ) <> 0; - if M1.FRadioGroup <> 0 then - M1.RadioCheckItem - else - if M1.FIsCheckItem then - M1.Checked := not M1.Checked; - if Assigned(M1.FOnMenuItem) then - M1.FOnMenuItem( M, Idx ) - else if Assigned( M.FOnMenuItem ) then - M.FOnMenuItem( M, Idx ); - break; + Sender := Sender.Parent; + M := PMenu( Sender.fMenuObj ); + end; + while M <> nil do + begin + Id := LoWord( Msg.wParam ); + M1 := M.Items[ Id ]; + if M1 <> nil then + begin + Result := True; + Rslt := 0; + Idx := M.IndexOf( M1 ); + M.fByAccel := HiWord( Msg.wParam ) <> 0; + if M1.FRadioGroup <> 0 then + M1.RadioCheckItem + else + if M1.FIsCheckItem then + M1.Checked := not M1.Checked; + if Assigned(M1.FOnMenuItem) then + M1.FOnMenuItem( M, Idx ) + else if Assigned( M.FOnMenuItem ) then + M.FOnMenuItem( M, Idx ); + break; + end; + M := M.fNextMenu; end; - M := M.fNextMenu; - end; end; end; end; @@ -28158,19 +28022,20 @@ function WndProcMenu( Sender: PControl; var Msg: TMsg; var Rslt: Integer): Boole begin Idx := M.IndexOf( M1 ); M.fByAccel := HiWord( Msg.wParam ) <> 0; - if M1.FRadioGroup <> 0 then - M1.RadioCheckItem + if M1.FRadioGroup <> 0 then + M1.RadioCheckItem else - if M1.FIsCheckItem then - M1.Checked := not M1.Checked; - if Assigned(M1.FOnMenuItem) then begin - {$IFDEF USE_MENU_CURCTL} // fixed - M.fCurCtl := Sender; // fixed - {$ENDIF} // fixed - M1.FOnMenuItem( M, Idx ) + if M1.FIsCheckItem then + M1.Checked := not M1.Checked; + if Assigned(M1.FOnMenuItem) then + begin + {$IFDEF USE_MENU_CURCTL} + M.fCurCtl := Sender; // fixed + {$ENDIF} + M1.FOnMenuItem( M, Idx ) end else if Assigned( M.FOnMenuItem ) then - M.FOnMenuItem( M, Idx ); + M.FOnMenuItem( M, Idx ); end; end; @@ -28204,7 +28069,6 @@ end; {$ENDIF WIN_GDI} -//[function NewMenu] {$IFDEF GDI} function NewMenu( AParent : PControl; MaxCmdReserve : DWORD; const Template : array of PKOLChar; aOnMenuItem: TOnMenuItem ): PMenu; @@ -28213,22 +28077,25 @@ var M: PMenu; R: TRect; {$ENDIF} begin - {-} New( Result, Create ); - {+}{++}(*Result := PMenu.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TMenu'; + {$ENDIF} Result.FVisible := TRUE; Result.FPopupFlags := TPM_LEFTALIGN or TPM_LEFTBUTTON; Result.FMenuItems := NewList; Result.FOnMenuItem := aOnMenuItem; if (High(Template)>=0) and (Template[0] <> nil) then begin - if (AParent <> nil) and (AParent.fMenuObj = nil) and not AParent.fIsControl then + if (AParent <> nil) and (AParent.fMenuObj = nil) and + {$IFDEF USE_FLAGS} not (G3_IsControl in AParent.fFlagsG3) + {$ELSE} not AParent.fIsControl {$ENDIF} then Result.FHandle := CreateMenu else Result.FHandle := CreatePopupMenu; Result.FillMenuItems( Result.FHandle, 0, Template ); end; - if assigned( AParent ) then + if ( AParent <> nil ) then begin Result.FControl := AParent; if AParent.fMenuObj <> nil then @@ -28241,47 +28108,48 @@ begin end else begin - if not AParent.fIsControl then - begin - {$IFDEF INITIALFORMSIZE_FIXMENU} - R := AParent.ClientRect; + if {$IFDEF USE_FLAGS} not(G3_IsControl in AParent.fFlagsG3) + {$ELSE} not AParent.fIsControl {$ENDIF} then + begin + {$IFDEF INITIALFORMSIZE_FIXMENU} + R := AParent.ClientRect; + {$ENDIF} + AParent.Menu := Result.FHandle; + {$IFDEF INITIALFORMSIZE_FIXMENU} + AParent.SetClientSize( R.Right, R.Bottom ); + {$ENDIF} + end; + AParent.fMenuObj := Result; + AParent.AttachProc( WndProcMenu ); + {$IFDEF USE_AUTOFREE4CONTROLS} + AParent.Add2AutoFree( Result ); {$ENDIF} - AParent.Menu := Result.FHandle; - {$IFDEF INITIALFORMSIZE_FIXMENU} - AParent.SetClientSize( R.Right, R.Bottom ); - {$ENDIF} - end; - AParent.fMenuObj := Result; - AParent.AttachProc( WndProcMenu ); - {$IFDEF USE_AUTOFREE4CONTROLS} - AParent.Add2AutoFree( Result ); - {$ENDIF} end; end; end; {$ENDIF GDI} + {$IFDEF _X_} {$IFDEF GTK} - //--- some code from samples - may be useful to see "how to" -Function AddSeparatorToMenu( Menu : PGtkMenu ) : PgtkMenuItem ; -begin +FUNCTION AddSeparatorToMenu( Menu : PGtkMenu ) : PgtkMenuItem ; +BEGIN Result := PGtkMenuitem( gtk_menu_item_new ) ; gtk_menu_append( GTK_WIDGET( Menu ), PGtkWidget( Result ) ) ; gtk_widget_show( PGtkWidget ( Result ) ) ; -end; +END; -Function AddItemToMenu( Menu : PGtkMenu; +FUNCTION AddItemToMenu( Menu : PGtkMenu; ShortCuts : PGtkAccelGroup; const Caption : AnsiString; const ShortCut : AnsiString; CallBack : TGtkSignalFunc; CallBackdata : Pointer ) : PGtkMenuItem; -Var +VAR Key, Modifiers : DWORD; //LocalAccelGroup : PGtkAccelGroup; -- not used since gtk_menu_ensure_uline_accel_group not defined anywhere... TheLabel : PGtkLabel; -begin +BEGIN Result := PGtkMenuItem ( gtk_menu_item_new_with_label( '' ) ) ; TheLabel := GTK_LABEL(GTK_BIN( Result )^.child ) ; Key:= gtk_label_parse_uline( TheLabel , Pchar ( Caption ) ) ; @@ -28296,39 +28164,39 @@ begin //----------------- gtk_menu_append( GTK_WIDGET( Menu ), PGtkWidget( Result ) ) ; //----------------- - If ( ShortCut<>'' ) and ( ShortCuts<> Nil ) then - begin - gtk_accelerator_parse ( pchar( ShortCut ) , @key , @modifiers ) ; - gtk_widget_add_accelerator ( PGtkWidget ( Result ) , ' activateitem' , - ShortCuts, Key, modifiers, GTK_ACCEL_VISIBLE ); - end; + IF ( ShortCut<>'' ) AND ( ShortCuts<> Nil ) THEN + BEGIN + gtk_accelerator_parse ( pchar( ShortCut ) , @key , @modifiers ) ; + gtk_widget_add_accelerator ( PGtkWidget ( Result ) , ' activateitem' , + ShortCuts, Key, modifiers, GTK_ACCEL_VISIBLE ); + END; //------------------ - If Assigned( CallBack ) then - begin + IF Assigned( CallBack ) THEN + BEGIN gtk_signal_connect( PGtkObject ( Result ) , 'activate' , CallBack , CallBackdata ) ; gtk_widget_show( PgtkWidget ( Result ) ) ; - end ; -end; + END; +END; -Function AddMenuToMenuBar( MenuBar : PGtkMenuBar; +FUNCTION AddMenuToMenuBar( MenuBar : PGtkMenuBar; ShortCuts : PGtkAccelGroup; Caption : AnsiString; CallBack : TGtkSignalFunc; CallBackdata : Pointer; AlignRight : Boolean; Var MenuItem : PgtkMenuItem ) : PGtkMenu; -Var Key : DWORD; +VAR Key : DWORD; TheLabel : PGtkLabel; -begin +BEGIN MenuItem := PGtkMenuItem( gtk_menu_item_new_with_label( '' ) ) ; - If AlignRight Then + IF AlignRight THEN gtk_menu_item_right_justify( MenuItem ); TheLabel := GTK_LABEL( GTK_BIN( MenuItem )^ .child ) ; Key := gtk_label_parse_uline( TheLabel, Pchar ( Caption ) ) ; - If Key<>0 then - gtk_widget_add_accelerator( PGtkWidget( MenuItem ), 'activateitem', - Shortcuts, Key, GDK_MOD1_MASK, GTK_ACCEL_LOCKED ); + IF Key<>0 THEN + gtk_widget_add_accelerator( PGtkWidget( MenuItem ), 'activateitem', + Shortcuts, Key, GDK_MOD1_MASK, GTK_ACCEL_LOCKED ); Result := PGtkMenu( gtk_menu_new ); If Assigned( CallBack ) then gtk_signal_connect( PGtkObject ( Result ), 'activate', @@ -28336,28 +28204,29 @@ begin gtk_widget_show( PgtkWidget ( MenuItem ) ) ; gtk_menu_item_set_submenu( MenuItem, PGtkWidget( Result ) ) ; gtk_menu_bar_append( GTK_WIDGET( MenuBar ), PgtkWidget( MenuItem ) ) ; -end; +END; -function NewMenu( AParent : PControl; MaxCmdReserve : DWORD; - const Template : array of PKOLChar; aOnMenuItem: TOnMenuItem ): PMenu; - procedure CreateMenuItems( ParentMenu: PMenu; var i: Integer ); - var Item, PrevItem: PMenu; +FUNCTION NewMenu( AParent : PControl; MaxCmdReserve : DWORD; + CONST Template : ARRAY of PKOLChar; aOnMenuItem: TOnMenuItem ): PMenu; + PROCEDURE CreateMenuItems( ParentMenu: PMenu; var i: Integer ); + VAR Item, PrevItem: PMenu; s: AnsiString; j: Integer; - begin + BEGIN PrevItem := nil; - while i <= High( Template )-1 do - begin + WHILE i <= High( Template )-1 DO + BEGIN inc( i ); s := Template[ i ]; - if s = '' then break; // end of template + IF s = '' THEN BREAK; // end of template - if s = ')' then - begin - inc( i ); break; // end of submenu - end; + IF s = ')' THEN + inc( i ); break; // end of submenu new( Item, Create ); + {$IFDEF DEBUG_OBJKIND} + Item.fObjKind := 'MenuItem'; + {$ENDIF} Item.FCaption := s; Item.FVisible := TRUE; Item.FParentMenu := ParentMenu; @@ -28365,92 +28234,83 @@ function NewMenu( AParent : PControl; MaxCmdReserve : DWORD; ParentMenu.FItems := NewList; ParentMenu.FItems.Add( Item ); - if (s <> '') and (s[ 1 ] in [ '+', '-' ]) then - begin - Item.fIsCheckItem := TRUE; - Item.fChecked := S[ 1 ] = '+'; - s := CopyEnd( s, 2 ); - if (s <> '') and (s[ 1 ] = '!') then - begin - if PrevItem <> nil then - begin - if PrevItem.fRadioGroup <> 0 then - Item.fRadioGroup := PrevItem.fRadioGroup; - end - else inc( Item.fRadioGroup ); + IF (s <> '') AND (s[ 1 ] in [ '+', '-' ]) THEN + BEGIN + Item.fIsCheckItem := TRUE; + Item.fChecked := S[ 1 ] = '+'; s := CopyEnd( s, 2 ); - end; - end; + IF (s <> '') and (s[ 1 ] = '!') THEN + BEGIN + IF PrevItem <> nil THEN + BEGIN + if PrevItem.fRadioGroup <> 0 THEN + Item.fRadioGroup := PrevItem.fRadioGroup; + END + ELSE inc( Item.fRadioGroup ); + s := CopyEnd( s, 2 ); + END; + END; - if s = '-' then - Item.fIsSeparator := TRUE - else - begin - // extract mnemonic - for j := Length( s )-1 downto 1 do - begin - if (s[ j ] = '&') and (s[ j+1 ] <> '&') then // mnemonic - begin - Item.fMnemonics := Item.fMnemonics + s[ j+1 ]; - Delete( s, j, 1 );//? m ? - end; - end; - end; + IF s = '-' THEN + Item.fIsSeparator := TRUE + ELSE + BEGIN + FOR j := Length( s )-1 DOWNTO 1 DO // extract mnemonic + BEGIN + IF (s[ j ] = '&') and (s[ j+1 ] <> '&') then // mnemonic + BEGIN + Item.fMnemonics := Item.fMnemonics + s[ j+1 ]; + Delete( s, j, 1 );//? m ? + END; + END; + END; //---------------------------- now call gtk for create item's widget - if Item.FIsSeparator then - Item.fGtkMenuItem := gtk_menu_item_new - else - Item.fGtkMenuItem := gtk_menu_item_new_with_label( PAnsiChar( s ) ); - if ParentMenu.fGtkMenuBar <> nil then - gtk_menu_bar_append( - ParentMenu.fGtkMenuBar, - Item.fGtkMenuItem ) - else - gtk_menu_shell_append( - GTK_MENU_SHELL( ParentMenu.fGtkMenuShell ), - Item.fGtkMenuItem ); + IF Item.FIsSeparator THEN + Item.fGtkMenuItem := gtk_menu_item_new + ELSE Item.fGtkMenuItem := gtk_menu_item_new_with_label( PAnsiChar( s ) ); + IF ParentMenu.fGtkMenuBar <> nil THEN + gtk_menu_bar_append( ParentMenu.fGtkMenuBar, Item.fGtkMenuItem ) + ELSE gtk_menu_shell_append( + GTK_MENU_SHELL( ParentMenu.fGtkMenuShell ), Item.fGtkMenuItem ); - if s = '(' then - begin - inc( i ); - if PrevItem <> nil then - begin - PrevItem.fGtkMenuShell := gtk_menu_new; - gtk_menu_item_set_submenu( - GTK_MENU_ITEM( PrevItem.fGtkMenuItem ), - PrevItem.fGtkMenuShell ); - CreateMenuItems( PrevItem, i ); - end; - end; + IF s = '(' THEN + BEGIN + inc( i ); + IF PrevItem <> nil THEN + BEGIN + PrevItem.fGtkMenuShell := gtk_menu_new; + gtk_menu_item_set_submenu( + GTK_MENU_ITEM( PrevItem.fGtkMenuItem ), + PrevItem.fGtkMenuShell ); + CreateMenuItems( PrevItem, i ); + END; + END; PrevItem := Item; - end; - end; -var i: Integer; -begin + END; + END; +VAR i: Integer; +BEGIN new( Result, Create ); i := -1; - if AParent.fMenuObj = nil then - begin // создается главное меню с линейкой меню (наверху формы? любого контрола?) - AParent.fMenuObj := Result; - Result.fGtkMenuBar := gtk_menu_bar_new; - //AParent.fMenuBar := Result.fGtkMenuBar; - gtk_container_add( GTK_CONTAINER( AParent.fClient ), Result.fGtkMenuBar ); - gtk_widget_show( Result.fGtkMenuBar ); - end - else - begin - PMenu( AParent.fMenuObj ).fNextMenu := Result; - Result.fGtkMenuShell := gtk_menu_new; - end; + IF AParent.fMenuObj = nil THEN + BEGIN // создается главное меню с линейкой меню (наверху формы? любого контрола?) + AParent.fMenuObj := Result; + Result.fGtkMenuBar := gtk_menu_bar_new; + //AParent.fMenuBar := Result.fGtkMenuBar; + gtk_container_add( GTK_CONTAINER( AParent.fClient ), Result.fGtkMenuBar ); + gtk_widget_show( Result.fGtkMenuBar ); + END else + BEGIN + PMenu( AParent.fMenuObj ).fNextMenu := Result; + Result.fGtkMenuShell := gtk_menu_new; + END; CreateMenuItems( Result, i ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[END NewMenu] -//[function NewMenuEx] function NewMenuEx( AParent : PControl; FirstCmd : Integer; const Template : array of PKOLChar; aOnMenuItems: array of TOnMenuItem ): PMenu; begin @@ -28459,7 +28319,6 @@ begin Result.AssignEvents( 0, aOnMenuItems ); {$ENDIF GDI} end; -//[END NewMenuEx] {$IFDEF WIN_GDI} { TMenu } @@ -28468,7 +28327,6 @@ const Breaks: array[ TMenuBreak ] of DWORD = ( 0, MFT_MENUBREAK, MFT_MENUBARBREAK ); { + by AK - Andrzej Kubaszek } -//[function MenuStructSize] function MenuStructSize: Integer; begin Result := 44; @@ -28477,7 +28335,6 @@ begin end; {$ENDIF WIN_GDI} -//[destructor TMenu.Destroy] {$IFDEF GDI} destructor TMenu.Destroy; var Next, Prnt: PMenu; @@ -28508,7 +28365,8 @@ begin if (FControl <> nil) and (FControl.fMenu = FHandle) and (FHandle <> 0) then begin //if FControl.fHandle <> 0 then - if not FControl.fDestroying then //!!!fix by Galkov + if {$IFDEF USE_FLAGS} not (G2_Destroying in FControl.fFlagsG2) + {$ELSE} not FControl.fDestroying {$ENDIF} then //!!!fix by Galkov begin Windows.SetMenu( FControl.fHandle, 0 ); // this removes main menu from window, but does not destroy it @@ -28545,61 +28403,30 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -destructor TMenu.Destroy; +DESTRUCTOR TMenu.Destroy; //var Next, Prnt: PMenu; -begin - {$IFDEF DEBUG_MENU_DESTROY} - LogFileOutput( GetStartDir + 'TMenu.Destroy.txt', - Int2Hex( DWORD( @ Self ), 6 ) + ' ' + Int2Str( RefCount ) ); - {$ENDIF} - //if Count > 0 then - if Assigned( fMenuItems ) then - begin - FMenuItems.ReleaseObjects; - FMenuItems := NewList; - end; - {if FParentMenu <> nil then - begin - Prnt := FParentMenu; - Next := Prnt.RemoveSubMenu( FId ); - FParentMenu := nil; - Prnt.FMenuItems.Remove( @ Self ); - if Next = nil then Exit; - end;} - {if (FControl <> nil) and (FControl.fMenu = FHandle) and (FHandle <> 0) then - begin - begin - Windows.SetMenu( FControl.fHandle, 0 ); - // this removes main menu from window, but does not destroy it - end; - FControl.fMenu := 0; - Next := PMenu( FControl.fMenuObj ); - while Next <> nil do - begin - if Next.fNextMenu = @Self then - begin - Next.fNextMenu := fNextMenu; - break; - end; - Next := Next.fNextMenu; - end; - end;} - //Next := fNextMenu; - //if FBitmap <> 0 then Bitmap := 0; - //if FHandle <> 0 then DestroyMenu( FHandle ); - FCaption := ''; - fMnemonics := ''; - FMenuItems.Free; - //Next.Free; - inherited; - // all later created (popup) menus (of the same control) - // are destroyed too -end; +BEGIN + {$IFDEF DEBUG_MENU_DESTROY} + LogFileOutput( GetStartDir + 'TMenu.Destroy.txt', + Int2Hex( DWORD( @ Self ), 6 ) + ' ' + Int2Str( RefCount ) ); + {$ENDIF} + //if Count > 0 then + IF ( fMenuItems <> nil ) THEN + BEGIN + FMenuItems.ReleaseObjects; + FMenuItems := NewList; + END; + FCaption := ''; + fMnemonics := ''; + FMenuItems.Free; + INHERITED; + // all later created (popup) menus (of the same control) + // are destroyed too +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -//[function TMenu.GetInfo] function TMenu.GetInfo( var MII: TMenuItemInfo ): Boolean; begin MII.cbSize := MenuStructSize; @@ -28607,7 +28434,6 @@ begin Windows.PMenuitemInfo( @ MII )^ ); end; -//[procedure TMenu.RedrawFormMenuBar] procedure TMenu.RedrawFormMenuBar; var C: PControl; begin @@ -28617,7 +28443,6 @@ begin DrawMenuBar( C.FHandle ); end; -//[function TMenu.SetInfo] function TMenu.SetInfo( var MII: TMenuItemInfo ): Boolean; var H: THandle; begin @@ -28634,7 +28459,6 @@ begin RedrawFormMenuBar; end; -//[function TMenu.SetTypeInfo] function TMenu.SetTypeInfo( var MII: TMenuItemInfo ): Boolean; begin if not FIsSeparator then @@ -28648,7 +28472,6 @@ begin Result := SetInfo( MII ); end; -//[function TMenu.GetTopParent] function TMenu.GetTopParent: PMenu; begin Result := @ Self; @@ -28656,13 +28479,11 @@ begin Result := Result.FParentMenu; end; -//[function TMenu.GetControl] function TMenu.GetControl: PControl; begin Result := TopParent.FControl; end; -//[function TMenu.GetItems] function TMenu.GetItems( Id: HMenu ): PMenu; function SearchItems( ParentMenu: PMenu; var FromIdx: Integer ): PMenu; var I: Integer; @@ -28685,7 +28506,6 @@ begin Result := SearchItems( @ Self, I ); end; -//[function TMenu.GetCount] function TMenu.GetCount: Integer; var I: Integer; SubM: PMenu; @@ -28698,7 +28518,6 @@ begin end; end; -//[function TMenu.IndexOf] function TMenu.IndexOf( Item: PMenu ): Integer; function SearchMenu( ParentMenu: PMenu; var FromIdx: Integer ): PMenu; var I: Integer; @@ -28719,7 +28538,6 @@ begin Result := -2; end; -//[function TMenu.GetState] function TMenu.GetState( const Index: Integer ): Boolean; var MII: TMenuItemInfo; begin @@ -28734,7 +28552,6 @@ begin Result := not Result; end; -//[procedure TMenu.SetState] procedure TMenu.SetState( const Index: Integer; Value: Boolean ); var MII: TMenuItemInfo; begin @@ -28754,7 +28571,6 @@ begin end; end; -//[procedure TMenu.SetData] procedure TMenu.SetData( Value: Pointer ); var MII: TMenuItemInfo; begin @@ -28764,7 +28580,6 @@ begin FData := Value; end; -//[procedure TMenu.ClearBitmaps] procedure TMenu.ClearBitmaps; begin if FBitmap <> 0 then @@ -28775,7 +28590,6 @@ begin DeleteObject( FBmpItem ); end; -//[procedure TMenu.SetBitmap] procedure TMenu.SetBitmap( Value: HBitmap ); var MII: TMenuItemInfo; begin @@ -28794,7 +28608,6 @@ begin SetInfo( MII ); end; -//[procedure TMenu.SetBmpChecked] procedure TMenu.SetBmpChecked( Value: HBitmap ); var MII: TMenuItemInfo; begin @@ -28813,7 +28626,6 @@ begin SetInfo( MII ); end; -//[procedure TMenu.SetBmpItem] procedure TMenu.SetBmpItem( Value: HBitmap ); var MII: TMenuItemInfo; begin @@ -28839,7 +28651,6 @@ begin SetInfo( MII ); end; -//[procedure TMenu.SetAccelerator] {$IFNDEF NEW_MENU_ACCELL} procedure TMenu.SetAccelerator(const Value: TMenuAccelerator); const MaxAccel = 1000; @@ -28919,7 +28730,6 @@ end; {$ENDIF NEW_MENU_ACCELL} -//[procedure TMenu.SetMenuItemCaption] procedure TMenu.SetMenuItemCaption( const Value: KOLString ); var MII: TMenuItemInfo; begin @@ -28938,7 +28748,6 @@ begin SetInfo( MII ); end; -//[procedure TMenu.SetMenuBreak] procedure TMenu.SetMenuBreak( Value: TMenuBreak ); var MII: TMenuItemInfo; begin @@ -28956,7 +28765,6 @@ begin end; end; -//[procedure TMenu.SetVisible] procedure TMenu.SetVisible( Value: Boolean ); var I, J: Integer; M: PMenu; @@ -29050,7 +28858,6 @@ begin RedrawFormMenuBar; end; -//[procedure TMenu.RadioCheckItem] procedure TMenu.RadioCheckItem; var I, J: Integer; M, First, Last: PMenu; @@ -29087,7 +28894,6 @@ begin Checked := TRUE; end; -//[function TMenu.FillMenuItems] function TMenu.FillMenuItems(AHandle: HMenu; StartIdx: Integer; const Template: array of PKOLChar): Integer; var S, S1: PKOLChar; @@ -29111,9 +28917,10 @@ begin Exit; end; - {-} new( Item, Create ); - {+}{++}(*Item := PMenu.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Item.fObjKind := 'MenuItem'; + {$ENDIF} Item.FVisible := TRUE; Item.FParentMenu := @ Self; Item.FMenuItems := NewList; @@ -29191,7 +28998,6 @@ begin Result := I; end; -//[procedure TMenu.AssignEvents] procedure TMenu.AssignEvents(StartIdx: Integer; const Events: array of TOnMenuItem); var I: Integer; @@ -29206,19 +29012,17 @@ begin end; end; -//[procedure TMenu.Popup] function TMenu.Popup(X, Y: Integer): Integer; begin {$IFDEF GDI} - if Assigned( fOnPopup ) then fOnPopup( @Self ); - if not FNotPopup then - Result := Integer( TrackPopupMenu( FHandle, FPopupFlags, {*ecm} - X, Y, 0, FControl.Handle, nil ) ) {*ecm} - else Result := 0; {*ecm} + if Assigned( fOnPopup ) then fOnPopup( @Self ); + if not FNotPopup then + Result := Integer( TrackPopupMenu( FHandle, FPopupFlags, {*ecm} + X, Y, 0, FControl.Handle, nil ) ) {*ecm} + else Result := 0; {*ecm} {$ENDIF GDI} end; -//[procedure TMenu.PopupEx] function TMenu.PopupEx( X, Y: Integer ): Integer; {$IFDEF GDI} var OldBounds: TRect; @@ -29230,12 +29034,13 @@ begin if FControl <> nil then begin OldBounds := FControl.BoundsRect; - if not FControl.fIsControl then + if {$IFDEF USE_FLAGS} not(G3_IsControl in FControl.fFlagsG3) + {$ELSE} not FControl.fIsControl {$ENDIF} then begin - WasVisible := FControl.Visible; - if not WasVisible then - FControl.Top := ScreenHeight + 50; - FControl.Show; + WasVisible := FControl.Visible; + if not WasVisible then + FControl.Top := ScreenHeight + 50; + FControl.Show; end; end; @@ -29255,43 +29060,36 @@ begin {$ENDIF GDI} end; -//[function TMenu.GetItemChecked] function TMenu.GetItemChecked( Item : Integer ) : Boolean; begin Result := Items[ Item ].Checked; end; -//[procedure TMenu.SetItemChecked] procedure TMenu.SetItemChecked( Item : Integer; Value : Boolean ); begin Items[ Item ].Checked := Value; end; -//[function TMenu.GetMenuItemHandle] function TMenu.GetMenuItemHandle( Idx : Integer ): DWORD; begin Result := Items[ Idx ].FId; end; -//[procedure TMenu.RadioCheck] procedure TMenu.RadioCheck( Idx : Integer ); begin Items[ Idx ].RadioCheckItem; end; -//[function TMenu.GetItemBitmap] function TMenu.GetItemBitmap(Idx: Integer): HBitmap; begin Result := Items[ Idx ].Bitmap; end; -//[procedure TMenu.SetItemBitmap] procedure TMenu.SetItemBitmap(Idx: Integer; const Value: HBitmap); begin Items[ Idx ].Bitmap := Value; end; -//[procedure TMenu.AssignBitmaps] procedure TMenu.AssignBitmaps(StartIdx: Integer; Bitmaps: array of HBitmap); var I: Integer; begin @@ -29299,72 +29097,60 @@ begin ItemBitmap[ I + StartIdx ] := Bitmaps[ I ]; end; -//[function TMenu.GetItemText] function TMenu.GetItemText(Idx: Integer): KOLString; begin Result := Items[ Idx ].FCaption; end; -//[procedure TMenu.SetItemText] procedure TMenu.SetItemText(Idx: Integer; const Value: KOLString); begin Items[ Idx ].Caption := Value; end; -//[function TMenu.GetItemEnabled] function TMenu.GetItemEnabled(Idx: Integer): Boolean; begin Result := Items[ Idx ].Enabled; end; -//[procedure TMenu.SetItemEnabled] procedure TMenu.SetItemEnabled(Idx: Integer; const Value: Boolean); begin Items[ Idx ].Enabled := Value; end; -//[function TMenu.GetItemVisible] function TMenu.GetItemVisible(Idx: Integer): Boolean; begin Result := Items[ Idx ].Visible; end; -//[procedure TMenu.SetItemVisible] procedure TMenu.SetItemVisible(Idx: Integer; const Value: Boolean); begin Items[ Idx ].Visible := Value; end; -//[function TMenu.ParentItem] function TMenu.ParentItem( Idx: Integer ): Integer; begin Result := TopParent.IndexOf( Items[ Idx ].FParentMenu ); end; -//[function TMenu.GetItemAccelerator] function TMenu.GetItemAccelerator(Idx: Integer): TMenuAccelerator; begin Result := Items[ Idx ].Accelerator; end; -//[procedure TMenu.SetItemAccelerator] procedure TMenu.SetItemAccelerator(Idx: Integer; const Value: TMenuAccelerator); begin Items[ Idx ].Accelerator := Value; end; -//[function TMenu.GetItemSubMenu] function TMenu.GetItemSubMenu( Idx: Integer ): HMenu; begin Result := Items[ Idx ].SubMenu; end; -//[function WndProcHelp FORWARD DECLARATION] function WndProcHelp( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; forward; {$IFDEF GDI} -//[procedure TMenu.SetHelpContext] procedure TMenu.SetHelpContext( Value: Integer ); var Form, C: PControl; begin @@ -29379,7 +29165,6 @@ begin end; {$ENDIF GDI} -//[procedure TMenu.SetSubmenu] procedure TMenu.SetSubmenu( Value: HMenu ); var MII: TMenuItemInfo; begin @@ -29389,7 +29174,6 @@ begin FHandle := Value; end; -//[function WndProcMeasureItem] function WndProcMeasureItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var MIS: PMeasureItemStruct; M, SM: PMenu; @@ -29407,18 +29191,17 @@ begin SM := M.Items[ MIS.itemID ]; if SM <> nil then begin - //MIS.itemWidth := 100; // VK: agree, this is not necessary Sender.CallDefWndProc( Msg ); I := M.IndexOf( SM ); - if Assigned( SM.OnMeasureItem ) then - M := SM; - if not Assigned( M.OnMeasureItem ) then - Exit; + if Assigned( SM.OnMeasureItem ) then + M := SM; + if not Assigned( M.OnMeasureItem ) then + Exit; H := M.OnMeasureItem( M, I ); - if HiWord( H ) <> 0 then - MIS.itemWidth := HiWord( H ); - if LoWord( H ) <> 0 then - MIS.itemHeight := LoWord( H ); + if HiWord( H ) <> 0 then + MIS.itemWidth := HiWord( H ); + if LoWord( H ) <> 0 then + MIS.itemHeight := LoWord( H ); Rslt := 1; Result := TRUE; break; @@ -29429,7 +29212,6 @@ begin end; end; -//[procedure TMenu.SetOnMeasureItem] procedure TMenu.SetOnMeasureItem( const Value: TOnMeasureItem ); var C: PControl; begin @@ -29439,7 +29221,6 @@ begin C.AttachProc( WndProcMeasureItem ); end; -//[function WndProcDrawItem] function WndProcDrawItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; type PDrawAction = ^TDrawAction; PDrawState = ^TDrawState; @@ -29460,15 +29241,14 @@ begin if SM <> nil then begin I := M.IndexOf( SM ); - if Assigned( SM.OnDrawItem ) then - M := SM; - if Assigned( M.OnDrawItem ) then + if Assigned( SM.OnDrawItem ) then + M := SM; + if Assigned( M.OnDrawItem ) then begin - if not M.OnDrawItem( M, DIS.hDC, DIS.rcItem, I, + if not M.OnDrawItem( M, DIS.hDC, DIS.rcItem, I, PDrawAction( @ DIS.itemAction )^, PDrawState( @ DIS.itemState )^ ) then Exit; - end - else Exit; + end else Exit; Rslt := 1; Result := TRUE; break; @@ -29479,7 +29259,6 @@ begin end; end; -//[procedure TMenu.SetOnDrawItem] procedure TMenu.SetOnDrawItem( const Value: TOnDrawItem ); var C: PControl; begin @@ -29489,7 +29268,6 @@ begin C.AttachProc( WndProcDrawItem ); end; -//[procedure TMenu.SetOwnerDraw] procedure TMenu.SetOwnerDraw( Value: Boolean ); const Masks: array[ Boolean ] of DWORD = ( 0, $FFFFFFFF ); var MII: TMenuItemInfo; @@ -29506,7 +29284,6 @@ begin end; end; -//[function TMenu.Insert] function TMenu.Insert(InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions): PMenu; const @@ -29517,9 +29294,10 @@ const var M: PMenu; MII: TMenuItemInfo; begin - {-} new( Result, Create ); - {+}{++}(*Result := PMenu.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TMenuItem'; + {$ENDIF} Result.FVisible := TRUE; Result.FParentMenu := @ Self; Result.FMenuItems := NewList; @@ -29575,20 +29353,17 @@ begin RedrawFormMenuBar; end; -//[function TMenu.AddItem] function TMenu.AddItem(ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions): Integer; begin Result := InsertItem( -1, ACaption, Event, Options ); end; -//[function TMenu.InsertItem] function TMenu.InsertItem( InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions): Integer; begin Result := InsertItemEx( InsertBefore, ACaption, Event, Options, FALSE ); end; -//[function TMenu.InsertItemEx] function TMenu.InsertItemEx(InsertBefore: Integer; ACaption: PKOLChar; Event: TOnMenuItem; Options: TMenuOptions; ByPosition: Boolean): Integer; var M: PMenu; @@ -29597,7 +29372,6 @@ begin Result := M.FId; end; -//[procedure TMenu.InsertSubMenu] procedure TMenu.InsertSubMenu( SubMenuToInsert: PMenu; InsertBefore: Integer ); var AFlags: DWORD; M: PMenu; @@ -29656,7 +29430,6 @@ begin RedrawFormMenuBar; end; -//[function TMenu.RemoveSubMenu] function TMenu.RemoveSubMenu( ItemToRemove: Integer ): PMenu; {$IFDEF DEBUG_MENU}var OK: Boolean; {$ENDIF} var M: PMenu; @@ -29681,43 +29454,36 @@ begin RedrawFormMenuBar; end; -//[function TMenu.GetItemHelpContext] function TMenu.GetItemHelpContext(Idx: Integer): Integer; begin Result := Items[ Idx ].HelpContext; end; -//[procedure TMenu.SetItemHelpContext] procedure TMenu.SetItemHelpContext(Idx: Integer; const Value: Integer); begin Items[ Idx ].HelpContext := Value; end; -//[procedure ClearText] procedure ClearText( Sender: PControl ); begin Sender.Caption := ''; end; -//[procedure ClearListbox] procedure ClearListbox( Sender: PControl ); begin Sender.Perform( LB_RESETCONTENT, 0, 0 ); end; -//[procedure ClearCombobox] procedure ClearCombobox( Sender: PControl ); begin Sender.Perform( CB_RESETCONTENT, 0, 0 ); end; -//[procedure ClearListView] procedure ClearListView( Sender: PControl ); begin Sender.Perform( LVM_DELETEALLITEMS, 0, 0 ); end; -//[procedure ClearToolbar] procedure ClearToolbar( Sender: PControl ); begin while Sender.TBButtonCount > 0 do @@ -29727,15 +29493,12 @@ end; {$ENDIF WIN_GDI} { -- Constructor of canvas -- } -//[function NewCanvas] function NewCanvas( DC: HDC ): PCanvas; begin - {-} New( Result, Create ); - {+} - {++}(* - Result := PCanvas.Create; - *){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TCanvas'; + {$ENDIF} {$IFDEF GDI} Result.ModeCopy := cmSrcCopy; if DC <> 0 then @@ -29745,32 +29508,176 @@ begin end; {$ENDIF GDI} end; -//[END NewCanvas] { -- Contructors of controls -- } -//[FUNCTION _NewTControl] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal -function _NewWindowed( AParent: PControl; ControlClassName: PKOLChar; Ctl3D: Boolean ): PControl; +{$IFDEF COMMANDACTIONS_OBJ} +function NewCommandActionsObj: PCommandActionsObj; +begin + new( Result, Create ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TCommandActionsObj'; + {$ENDIF} +end; + +{$IFDEF ASM_VERSION} +function NewCommandActionsObj_Packed( fromPack: PAnsiChar ): PCommandActionsObj; +asm + PUSH ESI + PUSH EDI + PUSH EAX + CALL NewCommandActionsObj + POP ESI + CMP ESI, 120 + MOV [EAX].TCommandActionsObj.fIndexInActions, ESI + JB @@exit + PUSH EAX + LEA EDI, [EAX].TCommandActionsObj.aClick + XOR EAX, EAX + LODSB + MOV dword ptr [EDI + 76], EAX // Result.fIndexInActions := fromPack[0] + XOR ECX, ECX + MOV CL, 38 +@@loop: + CMP byte ptr[ESI], 200 + JB @@copy_word + JA @@clear_words + INC ESI +@@copy_word: + MOVSW + LOOP @@loop + JMP @@fin +@@clear_words: + LODSB + SUB AL, 200 + SUB CL, AL + PUSH ECX + MOVZX ECX, AL + XOR EAX, EAX + REP STOSW + POP ECX + INC ECX + LOOP @@loop +@@fin: + POP EAX +@@exit: + POP EDI + POP ESI +end; +{$ELSE PASCAL} +function NewCommandActionsObj_Packed( fromPack: PAnsiChar ): PCommandActionsObj; +var Dest: PWord; + N, i: Integer; +begin + new( Result, Create ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TCommandActionsObj'; + {$ENDIF} + if Integer( fromPack ) < 120 then + begin + Result.fIndexInActions := Integer( fromPack ); + Exit; + end; + Result.fIndexInActions := Byte( fromPack^ ); + inc( fromPack ); + Dest := Pointer( @Result.aClick ); + N := 38; + while N > 0 do + begin + if Byte( fromPack^ ) < 200 then + begin + Dest^ := PWord( fromPack )^; + inc( Dest ); + inc( fromPack, 2 ); + dec( N ); + end + else + if Byte( fromPack^ ) = 200 then + begin + inc( fromPack ); + Dest^ := PWord( fromPack )^; + inc( Dest ); + inc( fromPack, 2 ); + dec( N ); + end + else + begin + i := Byte( fromPack^ ) - 200; + while i > 0 do + begin + Dest^ := 0; + inc( Dest ); + dec( i ); + dec( N ); + end; + inc( fromPack ); + end; + end; +end; +{$ENDIF ASM_VERSION} +{$ENDIF COMMANDACTIONS_OBJ} + +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal +function _NewWindowed( AParent: PControl; ControlClassName: PKOLChar; + Ctl3D: Boolean; ACommandActions: TCommandActionsParam ): PControl; +{$IFDEF COMMANDACTIONS_OBJ} +var IdxActions: Integer; +{$ENDIF} begin - {-} New( Result, CreateParented( AParent ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl'; + {$ENDIF} + {$IFDEF COMMANDACTIONS_OBJ} + if Integer( ACommandActions ) < 120 then + IdxActions := Integer( ACommandActions ) + else + IdxActions := PByte( ACommandActions )^; + if AllActions_Objs[IdxActions] <> nil then + begin + Result.fCommandActions := AllActions_Objs[IdxActions]; + Result.fCommandActions.RefInc; + end + else + begin + {$IFDEF PACK_COMMANDACTIONS} + Result.fCommandActions := NewCommandActionsObj_Packed( ACommandActions ); + AllActions_Objs[IdxActions] := Result.fCommandActions; + Result.fCommandActions.aClear := ClearText; + {$ELSE} + new( Result.fCommandActions, Create ); + {$IFDEF DEBUG_OBJKIND} + Result.fCommandActions.fObjKind := 'TCommandActionsObj'; + {$ENDIF} + AllActions_Objs[IdxActions] := Result.fCommandActions; + if ACommandActions <> nil then + Move( ACommandActions^, Result.fCommandActions.aClear, + Sizeof( TCommandActions ) ) + else + Result.fCommandActions.aClear := ClearText; + {$ENDIF} + end; + Result.Add2AutoFree( Result.fCommandActions ); + {$ELSE} + if ACommandActions <> nil then + Result.fCommandActions := ACommandActions^ + else + Result.fCommandActions.aClear := ClearText; + {$ENDIF} //Result.fWindowed := TRUE; // is set in TControl.Init - {+}{++}(*Result := PControl.CreateParented( AParent );*){--} Result.fControlClassName := ControlClassName; if AParent <> nil then begin {$IFDEF WIN_GDI} - Result.fWndProcResizeFlicks := AParent.fWndProcResizeFlicks; + //{-2.95}Result.PP.fWndProcResizeFlicks := AParent.PP.fWndProcResizeFlicks; {$ENDIF WIN_GDI} - Result.fGotoControl := AParent.fGotoControl; - Result.fCtl3Dchild := AParent.fCtl3Dchild; - if AParent.fCtl3Dchild then - Result.fCtl3D := Ctl3D - else - Result.fCtl3D := False; // + Result.PP.fGotoControl := AParent.PP.fGotoControl; + Result.fCtl3D_child := AParent.fCtl3D_child and 2; + if AParent.fCtl3D_child and 2 <> 0 then + Result.fCtl3D_child := Result.fCtl3D_child or Integer( Ctl3D ) and 1 + {else + Result.fCtl3D := False}; // Result.fMargin := AParent.fMargin; Result.fTextColor := AParent.fTextColor; {$IFDEF SMALLEST_CODE} @@ -29803,143 +29710,144 @@ begin {$ENDIF WIN_GDI} end; end; -//[END _NewWindowed] {$ENDIF ASM_VERSION} {$ENDIF GDI} + {$IFDEF _X_} {$IFDEF GTK} -var GTK_initialized: Boolean; +VAR GTK_initialized: Boolean; argc: Integer = 0; -procedure FixedChildSetPos( Ctl, Chld: PControl; x, y: Integer ); -begin +PROCEDURE FixedChildSetPos( Ctl, Chld: PControl; x, y: Integer ); +BEGIN gtk_fixed_move( GTK_FIXED( Ctl.fClient ), Chld.fEventboxHandle, x, y ); -end; +END; -procedure LayoutChildSetPos( Ctl, Chld: PControl; x, y: Integer ); -begin +PROCEDURE LayoutChildSetPos( Ctl, Chld: PControl; x, y: Integer ); +BEGIN gtk_layout_move( GTK_LAYOUT( Ctl.fClient ), Chld.fEventboxHandle, x, y ); -end; +END; -procedure FixedChildPut( Ctl, Chld: PControl; x, y: Integer ); -begin +PROCEDURE FixedChildPut( Ctl, Chld: PControl; x, y: Integer ); +BEGIN gtk_fixed_put( GTK_FIXED( Ctl.fClient ), Chld.fEventboxHandle, x, y ); -end; +END; -procedure LayoutChildPut( Ctl, Chld: PControl; x, y: Integer ); -begin +PROCEDURE LayoutChildPut( Ctl, Chld: PControl; x, y: Integer ); +BEGIN gtk_layout_put( GTK_LAYOUT( Ctl.fClient ), Chld.fEventboxHandle, x, y ); -end; +END; -function FixedClientArea( Ctl: PControl ): PGtkWidget; -begin - if Ctl.fClient = nil then - begin - Ctl.fClient := gtk_fixed_new; - gtk_container_set_border_width(GTK_CONTAINER(Ctl.fHandle), 0); - gtk_container_add( GTK_CONTAINER( Ctl.fHandle ), Ctl.fClient ); - gtk_container_set_border_width(GTK_CONTAINER(Ctl.fClient), 0); - gtk_widget_show( Ctl.fClient ); - Ctl.fChildPut := FixedChildPut; - Ctl.fChildSetPos := FixedChildSetPos; - end; +FUNCTION FixedClientArea( Ctl: PControl ): PGtkWidget; +BEGIN + IF Ctl.fClient = nil THEN + BEGIN + Ctl.fClient := gtk_fixed_new; + gtk_container_set_border_width(GTK_CONTAINER(Ctl.fHandle), 0); + gtk_container_add( GTK_CONTAINER( Ctl.fHandle ), Ctl.fClient ); + gtk_container_set_border_width(GTK_CONTAINER(Ctl.fClient), 0); + gtk_widget_show( Ctl.fClient ); + Ctl.fChildPut := FixedChildPut; + Ctl.fChildSetPos := FixedChildSetPos; + END; Result := Ctl.fClient; -end; +END; -function ClientAreaLayout( Ctl: PControl ): PGtkWidget; -begin - if Ctl.fClient = nil then - begin - Ctl.fClient := gtk_layout_new( {hadjustment} nil, {vadjustment} nil ); - Ctl.fChildPut := LayoutChildPut; - Ctl.fChildSetPos := LayoutChildSetPos; - end; +FUNCTION ClientAreaLayout( Ctl: PControl ): PGtkWidget; +BEGIN + IF Ctl.fClient = nil THEN + BEGIN + Ctl.fClient := gtk_layout_new( {hadjustment} nil, {vadjustment} nil ); + Ctl.fChildPut := LayoutChildPut; + Ctl.fChildSetPos := LayoutChildSetPos; + END; Result := Ctl.fClient; -end; +END; -function _NewWindowed( AParent: PControl; ControlClassName: PAnsiChar; +FUNCTION _NewWindowed( AParent: PControl; ControlClassName: PAnsiChar; widget: PGtkWidget; need_eventbox: Boolean ): PControl; //var GVal: TGValue; -begin +BEGIN (*if not GTK_initialized then begin GTK_initialized := TRUE; gtk_init( @ argc, {@ argv} nil ); end;*) - {-} New( Result, CreateParented( AParent, widget, need_eventbox ) ); //Result.fWindowed := TRUE; // is set in TControl.Init //???//Result.fControlClassName := ControlClassName; - if AParent <> nil then - begin + IF AParent <> nil THEN + BEGIN Result.fGotoControl := AParent.fGotoControl; - {Result.fCtl3Dchild := AParent.fCtl3Dchild; - if AParent.fCtl3Dchild then - Result.fCtl3D := Ctl3D - else - Result.fCtl3D := False;} Result.fMargin := AParent.fMargin; Result.fTextColor := AParent.fTextColor; {$IFDEF SMALLEST_CODE} {$ELSE} {$IFDEF WIN_GDI} // for now Font is complicated a bit, implement it later Result.fFont := Result.fFont.Assign( AParent.fFont ); - if Result.fFont <> nil then + IF Result.fFont <> nil THEN begin - {$IFDEF USE_AUTOFREE4CONTROLS} - Result.Add2AutoFree( Result.fFont ); - {$ENDIF USE_AUTOFREE4CONTROLS} - Result.fFont.fParentGDITool := AParent.fFont; - Result.fFont.fOnChange := Result.FontChanged; - Result.FontChanged( Result.fFont ); - end; + {$IFDEF USE_AUTOFREE4CONTROLS} + Result.Add2AutoFree( Result.fFont ); + {$ENDIF USE_AUTOFREE4CONTROLS} + Result.fFont.fParentGDITool := AParent.fFont; + Result.fFont.fOnChange := Result.FontChanged; + Result.FontChanged( Result.fFont ); + END; {$ENDIF WIN_GDI} {$ENDIF SMALLEST_CODE} Result.fColor := AParent.fColor; {$IFDEF WIN_GDI} Result.fBrush := Result.fBrush.Assign( AParent.fBrush ); - if Result.fBrush <> nil then - begin - {$IFDEF USE_AUTOFREE4CONTROLS} - Result.Add2AutoFree( Result.fBrush ); - {$ENDIF USE_AUTOFREE4CONTROLS} - Result.fBrush.fParentGDITool := AParent.fBrush; - Result.fBrush.fOnChange := Result.BrushChanged; - Result.BrushChanged( Result.fBrush ); - end; + IF Result.fBrush <> nil THEN + BEGIN + {$IFDEF USE_AUTOFREE4CONTROLS} + Result.Add2AutoFree( Result.fBrush ); + {$ENDIF USE_AUTOFREE4CONTROLS} + Result.fBrush.fParentGDITool := AParent.fBrush; + Result.fBrush.fOnChange := Result.BrushChanged; + Result.BrushChanged( Result.fBrush ); + END; {$ENDIF WIN_GDI} - end; + END; Result.fGetClientArea := FixedClientArea; -end; +END; {$ENDIF GTK} {$ENDIF _X_} //===================== Form ========================// {$IFDEF USE_CONSTRUCTORS} -//[function NewForm] function NewForm( AParent: PControl; const Caption: AnsiString ): PControl; begin new( Result, CreateForm( AParent, Caption ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Form'; + {$ENDIF} end; -//[END NewForm] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewForm] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewForm( AParent: PControl; const Caption: KOLString ): PControl; begin - Result := _NewWindowed( AParent, 'Form', True ); + Result := _NewWindowed( AParent, 'Form', True, + {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS ) + {$ELSE} nil {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Form'; + {$ENDIF} Result.fClsStyle := Result.fClsStyle or CS_DBLCLKS; Result.AttachProc( WndProcForm ); Result.AttachProc( WndProcDoEraseBkgnd ); - {$IFNDEF SMALLEST_CODE} - Result.fSizeGrip := TRUE; - {$ENDIF} Result.Caption := Caption; - Result.fIsForm := TRUE; + {$IFDEF USE_FLAGS} Result.fFlagsG3 := Result.fFlagsG3 + [G3_SizeGrip, G3_IsForm]; + {$ELSE} + {$IFNDEF SMALLEST_CODE} + Result.fSizeGrip := TRUE; + {$ENDIF} + Result.fIsForm := TRUE; + {$ENDIF} end; {$ENDIF ASM_VERSION} @@ -29947,14 +29855,18 @@ const Edgestyles: array[ TEdgeStyle ] of DWORD = ( WS_DLGFRAME, SS_SUNKEN, 0, 0, function NewAlienPanel( AParentWnd: HWnd; EdgeStyle: TEdgeStyle ): PControl; begin - Result := _NewWindowed( nil, 'KOL', TRUE ); + Result := _NewWindowed( nil, 'KOL', TRUE, + {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS ) + {$ELSE} nil {$ENDIF} ); Result.fClsStyle := Result.fClsStyle or CS_DBLCLKS; Result.FParentWnd := AParentWnd; Result.AttachProc( WndProcForm ); Result.AttachProc( WndProcDoEraseBkgnd ); - Result.fIsForm := TRUE; - Result.fIsControl := TRUE; - Result.fStyle := WS_VISIBLE or WS_CHILD or WS_TABSTOP or + {$IFDEF USE_FLAGS} Result.fFlagsG3 := Result.fFlagsG3 + [G3_IsForm, G3_IsControl]; + {$ELSE} Result.fIsForm := TRUE; + Result.fIsControl := TRUE; + {$ENDIF} + Result.fStyle.Value := WS_VISIBLE or WS_CHILD or WS_TABSTOP or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or Edgestyles[ EdgeStyle ]; Result.fExStyle := Result.fExStyle //or WS_EX_CLIENTEDGE or WS_EX_CONTROLPARENT; @@ -29964,68 +29876,59 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function getFormCaption(F: PControl): KOLString; -begin +FUNCTION getFormCaption(F: PControl): KOLString; +BEGIN F.fCaption := gtk_window_get_title( GTK_WINDOW( F.fHandle ) ); Result := F.fCaption; -end; +END; -procedure setFormCaption(F: PControl; const Value: KOLString); -begin +PROCEDURE setFormCaption(F: PControl; const Value: KOLString); +BEGIN F.fCaption := Value; gtk_window_set_title( GTK_WINDOW( F.fCaptionHandle ), PAnsiChar( String( Value ) ) ); -end; +END; -procedure DestroyForm( Widget: PGtkWidget; Sender: PControl ); cdecl; -var Quit: Boolean; -begin +PROCEDURE DestroyForm( Widget: PGtkWidget; Sender: PControl ); CDECL; +VAR Quit: Boolean; +BEGIN Quit := Sender.IsMainWindow; Sender.Free; - if Quit then - gtk_main_quit(); -end; + IF Quit THEN + gtk_main_quit(); +END; -function NewForm( AParent: PControl; const Caption: KOLString ): PControl; -{$IFDEF GTK} -var widget: PGtkWidget; -{$ENDIF GTK} -begin - if not GTK_initialized then - begin +FUNCTION NewForm( AParent: PControl; const Caption: KOLString ): PControl; +VAR widget: PGtkWidget; +BEGIN + IF not GTK_initialized THEN + BEGIN GTK_initialized := TRUE; gtk_init( @ argc, {@ argv} nil ); - end; - {$IFDEF GDI} - Result := _NewWindowed( AParent, 'Form', True ); - {$ELSE _X_} - {$IFDEF GTK} - widget := gtk_window_new( GTK_WINDOW_TOPLEVEL ); - Result := _NewWindowed( AParent, 'Form', widget, FALSE ); - {$ENDIF GTK} - {$ENDIF _X_} + END; + widget := gtk_window_new( GTK_WINDOW_TOPLEVEL ); + Result := _NewWindowed( AParent, 'Form', widget, FALSE ); Result.fGetCaption := getFormCaption; Result.fSetCaption := setFormCaption; Result.Caption := Caption; - Result.fIsForm := TRUE; + {$IFDEF USE_FLAGS} include( Result.fFlagsG3, G3_IsForm ); + {$ELSE} Result.fIsForm := TRUE; {$ENDIF} gtk_signal_connect( Pointer( Result.fHandle ), 'destroy', - @ DestroyForm, Result ); -end; + @ DestroyForm, Result ); +END; {$ENDIF GTK} {$ENDIF _X_} -//[END NewForm] {$ENDIF USE_CONSTRUCTORS} {$IFDEF WIN_GDI} //vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv //===================== Applet button ========================// -//[FUNCTION WndProcApp] //22{$IFDEF ASM_VERSION} function WndProcAppAsm(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; asm CMP word ptr [EDX].TMsg.message, WM_SETFOCUS JNZ @@chk_CLOSE - MOV ECX, [EAX].TControl.FCurrentControl + MOV ECX, [EAX].TControl.DF.FCurrentControl JECXZ @@ret_false XCHG EAX, ECX PUSH EAX @@ -30079,16 +29982,20 @@ begin case Msg.message of WM_SETFOCUS: {$IFDEF NEW_MODAL} - if Self_.fModalForm <> nil then - SetFocus( Self_.fModalForm.fHandle ) - else if ( Self_.FCurrentControl <> nil ) and not - ( Self_.fCurrentControl.IsForm xor Self_.fIsApplet ) then + if Self_.DF.fModalForm <> nil then + SetFocus( Self_.DF.fModalForm.fHandle ) + else if ( Self_.DF.FCurrentControl <> nil ) and not + ( {$IFDEF USE_FLAGS} (G3_IsForm in Self_.DF.fCurrentControl.fFlagsG3) + {$ELSE} Self_.DF.fCurrentControl.fIsForm {$ENDIF} + xor + {$IFDEF USE_FLAGS} (G3_IsApplet in Self_.fFlagsG3) + {$ELSE} Self_.fIsApplet {$ENDIF} ) then {$ELSE not_NEW_MODAL} - if Self_.FCurrentControl <> nil then + if Self_.DF.fCurrentControl <> nil then {$ENDIF NEW_MODAL} begin - if Self_.FCurrentControl.CreateWindow then - SetFocus( Self_.FCurrentControl.fHandle ); + if Self_.DF.FCurrentControl.CreateWindow then + SetFocus( Self_.DF.FCurrentControl.fHandle ); Result := True; end; WM_SYSCOMMAND: @@ -30104,19 +30011,18 @@ begin END; end; end; -//[END WndProcApp] {$IFDEF USE_CONSTRUCTORS} {$DEFINE CREATEAPPBUTTON_USED} -//[function NewApplet] function NewApplet( const Caption: AnsiString ): PControl; begin new( Result, CreateApplet( Caption ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Applet'; + {$ENDIF} end; -//[END NewApplet] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewApplet] {$IFDEF ASM_TLIST} function NewApplet( const Caption: KOLString ): PControl; const AppClass: array[ 0..3 ] of KOLChar = ( 'A', 'p', 'p', #0 ); @@ -30127,8 +30033,13 @@ asm PUSH EAX MOV EDX, offset[AppClass] XOR EAX, EAX + PUSH EAX CALL _NewWindowed + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG3, (1 shl G3_IsApplet) + {$ELSE} INC [EAX].TControl.FIsApplet + {$ENDIF} MOV word ptr [EAX].TControl.fStyle + 2, $90CA //WS_VISIBLE or WS_SYSMENU or WS_POPUP or WS_MINIMIZEBOX or WS_CAPTION MOV byte ptr [EAX].TControl.fExStyle + 2, WS_EX_APPWINDOW shr 16 // WS_EX_APPWINDOW = $40000 CALL @@newapp1 @@ -30204,15 +30115,14 @@ asm JMP @@ret_false @@newapp1: - //MOV [EAX].TControl.FCreateWndExt, offset[CreateAppButton] - POP [EAX].TControl.FCreateWndExt + POP [EAX].TControl.PP.FCreateWndExt PUSH EAX CALL @@newapp2 // BODY of WndProcApp here: CMP word ptr [EDX].TMsg.message, WM_SETFOCUS JNZ @@chk_CLOSE - MOV ECX, [EAX].TControl.FCurrentControl + MOV ECX, [EAX].TControl.DF.fCurrentControl JECXZ @@ret_false XCHG EAX, ECX @@ -30236,7 +30146,6 @@ asm end; {$ELSE ASM_VERSION} //Pascal -//[procedure CreateAppButton] procedure CreateAppButton( App: PControl ); var M: HMenu; begin @@ -30247,15 +30156,20 @@ begin EnableMenuItem( M, SC_RESTORE, MF_GRAYED or MF_BYCOMMAND ); end; -//[function NewApplet] function NewApplet( const Caption: KOLString ): PControl; begin AppButtonUsed := True; - Result := _NewWindowed( nil, 'App', True ); - Result.FIsApplet := TRUE; - Result.fStyle := WS_VISIBLE or WS_SYSMENU or WS_POPUP or WS_MINIMIZEBOX or WS_CAPTION; + Result := _NewWindowed( nil, 'App', True, + {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS ) + {$ELSE} nil {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Applet'; + {$ENDIF} + {$IFDEF USE_FLAGS} include( Result.fFlagsG3, G3_IsApplet ); + {$ELSE} Result.FIsApplet := TRUE; {$ENDIF} + Result.fStyle.Value := WS_VISIBLE or WS_SYSMENU or WS_POPUP or WS_MINIMIZEBOX or WS_CAPTION; Result.fExStyle := WS_EX_APPWINDOW; - Result.FCreateWndExt := CreateAppButton; + Result.PP.FCreateWndExt := CreateAppButton; {$IFDEF ASM_VERSION} Result.AttachProc( WndProcAppAsm ); {$ELSE} @@ -30264,7 +30178,6 @@ begin Result.Caption := Caption; end; {$ENDIF ASM_VERSION} -//[END NewApplet] {$ENDIF USE_CONSTRUCTORS} {$IFDEF CREATEAPPBUTTON_USED} @@ -30314,96 +30227,99 @@ var CtlIdCount: WORD = $8000; {$ENDIF WIN_GDI} -//[FUNCTION _NewControl] {$IFDEF GDI} {$IFDEF ASM_UNICODE} function _NewControl( AParent: PControl; ControlClassName: PKOLChar; - Style: DWORD; Ctl3D: Boolean; Actions: PCommandActions ): PControl; + Style: DWORD; Ctl3D: Boolean; + Actions: TCommandActionsParam ): PControl; const szActions = sizeof(TCommandActions); asm PUSH EBX PUSH EAX // push AParent PUSH ECX // push Style - MOVZX ECX, Ctl3D - CALL _NewWindowed - XCHG EBX, EAX - INC [EBX].TControl.fIsControl - INC [EBX].TControl.fVerticalAlign - MOV EAX, Actions - TEST EAX, EAX - JZ @@noActions - LEA EDX, [EBX].TControl.fCommandActions - XOR ECX, ECX - MOV CL, szActions - CALL System.Move -@@noActions: + MOVZX ECX, [Ctl3D] + PUSH [Actions] + CALL _NewWindowed + XCHG EBX, EAX + {$IFDEF USE_FLAGS} + OR [EBX].TControl.fFlagsG3, (1 shl G3_IsControl) + {$ELSE} + INC [EBX].TControl.fIsControl + {$ENDIF} POP EDX // pop Style OR EDX, WS_CLIPSIBLINGS or WS_CLIPCHILDREN + INC [EBX].TControl.fVerticalAlign MOV byte ptr [EBX].TControl.fLookTabKeys, $0F - CMP [EBX].TControl.fCtl3D, 0 + TEST [EBX].TControl.fCtl3D_child, 1 JZ @@noCtl3D AND EDX, not WS_BORDER OR byte ptr [EBX].TControl.fExStyle + 1, WS_EX_CLIENTEDGE shr 8 @@noCtl3D: MOV [EBX].TControl.fStyle, EDX - TEST EDX, WS_VISIBLE - SETNZ AL - MOV [EBX].TControl.fVisible, AL - TEST EDX, WS_TABSTOP + {$IFDEF USE_FLAGS} + {$ELSE} + TEST EDX, WS_VISIBLE + SETNZ AL + MOV [EBX].TControl.fVisible, AL + TEST EDX, WS_TABSTOP + SETNZ AL + MOV [EBX].TControl.fTabstop, AL + {$ENDIF USE_FLAGS} POP ECX // pop AParent - PUSHFD JECXZ @@noParent PUSH ESI PUSH EDI - LEA ESI, [ECX].TControl.fMargin - LEA EDI, [EBX].TControl.fBoundsRect - LODSD - {$IFNDEF SMALLEST_CODE} - PUSH EAX - ADD EAX, [ESI+24] // AParent.fClientLeft - {$ENDIF} - STOSD // fBoundsRect.Left - {$IFNDEF SMALLEST_CODE} - POP EAX - PUSH EAX - ADD EAX, [ESI+16] // AParent.fClientTop - {$ENDIF} - STOSD // fBoundsRect.Top - {$IFNDEF SMALLEST_CODE} - XCHG EDX, EAX - POP EAX - {$ENDIF} - ADD EAX, 64 - STOSD // fBoundsRect.Right - {$IFNDEF SMALLEST_CODE} - XCHG EAX, EDX - ADD EAX, 64 - {$ENDIF} - STOSD // fBoundsRect.Bottom} + PUSH ECX + LEA ESI, [ECX].TControl.fMargin + LEA EDI, [EBX].TControl.fBoundsRect + LODSB + MOVSX EAX, AL + {$IFNDEF SMALLEST_CODE} + PUSH EAX + MOVSX ECX, byte ptr [ESI+2] + ADD EAX, ECX // AParent.fClientLeft + {$ENDIF} + STOSD // fBoundsRect.Left + {$IFNDEF SMALLEST_CODE} + POP EAX + PUSH EAX + MOVSX ECX, byte ptr [ESI+0] + ADD EAX, ECX // AParent.fClientTop + {$ENDIF} + STOSD // fBoundsRect.Top + {$IFNDEF SMALLEST_CODE} + XCHG EDX, EAX + POP EAX + {$ENDIF} + ADD EAX, 64 + STOSD // fBoundsRect.Right + {$IFNDEF SMALLEST_CODE} + XCHG EAX, EDX + ADD EAX, 64 + {$ENDIF} + STOSD // fBoundsRect.Bottom} + POP ECX + MOV EAX, [ECX].TControl.fCursor + STOSD POP EDI POP ESI - MOV EAX, [ECX].TControl.fCursor - MOV [EBX].TControl.fCursor, EAX XCHG EAX, ECX CALL TControl.ParentForm XCHG ECX, EAX - JECXZ @@noParent + JECXZ @@noParentForm INC [ECX].TControl.fTabOrder - MOV EDX, [ECX].TControl.fTabOrder - MOV [EBX].TControl.fTabOrder, EDX + MOV DX, WORD PTR [ECX].TControl.fTabOrder + MOV WORD PTR [EBX].TControl.fTabOrder, DX + TEST [EBX].TControl.fStyle, WS_TABSTOP + JZ @@CurrentControl_set + CMP [ECX].TControl.DF.fCurrentControl, 0 + JZ @@CurrentControl_set + MOV [ECX].TControl.DF.fCurrentControl, EBX +@@CurrentControl_set: +@@noParentForm: @@noParent: - POPFD - JZ @@noTabStop - INC [EBX].TControl.fTabstop - JECXZ @@noTabstop - XCHG EAX, ECX - MOV ECX, [EAX].TControl.FCurrentControl - INC ECX - LOOP @@noTabStop - MOV [EAX].TControl.FCurrentControl, EBX -@@noTabStop: MOVZX EDX, [CtlIdCount] INC [CtlIdCount] MOV [EBX].TControl.fMenu, EDX @@ -30415,17 +30331,28 @@ asm end; {$ELSE ASM_VERSION} //Pascal function _NewControl( AParent: PControl; ControlClassName: PKOLChar; - Style: DWORD; Ctl3D: Boolean; Actions: PCommandActions ): PControl; + Style: DWORD; Ctl3D: Boolean; Actions: TCommandActionsParam ): PControl; var Form: PControl; begin - Result := _NewWindowed( AParent, ControlClassName, Ctl3D ); - if Actions <> nil then - Result.fCommandActions := Actions^; - Result.fIsControl := True; - Result.fStyle := Style or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; + Result := _NewWindowed( AParent, ControlClassName, Ctl3D, Actions ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl'; + {$ENDIF} + {$IFDEF USE_FLAGS} include( Result.fFlagsG3, G3_IsControl ); + {$ELSE} Result.fIsControl := True; {$ENDIF} + Result.fStyle.Value := Style or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; Result.fVerticalAlign := vaTop; + Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ]; + if Result.fCtl3D_child and 1 <> 0 then + begin + Result.fStyle.Value := Result.fStyle.Value and not WS_BORDER; + Result.fExStyle := Result.fExStyle or WS_EX_CLIENTEDGE; + end; + {$IFDEF USE_FLAGS} + {$ELSE} Result.fVisible := (Style and WS_VISIBLE) <> 0; Result.fTabstop := (Style and WS_TABSTOP) <> 0; + {$ENDIF} if (AParent <> nil) then begin with Result.fBoundsRect do @@ -30440,65 +30367,58 @@ begin begin Inc( Form.fTabOrder ); Result.fTabOrder := Form.fTabOrder; + if F2_Tabstop in Result.fStyle.f2_Style then + begin + if Form.DF.FCurrentControl = nil then + Form.DF.FCurrentControl := Result; + end; end; Result.fCursor := AParent.fCursor; end; - Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ]; - if Result.fCtl3D then - begin - Result.fStyle := Result.fStyle and not WS_BORDER; - Result.fExStyle := Result.fExStyle or WS_EX_CLIENTEDGE; - end; - if (Style and WS_TABSTOP) <> 0 then - begin - Form := Result.ParentForm; - if Form <> nil then - if Form.FCurrentControl = nil then - Form.FCurrentControl := Result; - end; Result.fMenu := CtlIdCount; Inc( CtlIdCount ); Result.AttachProc( WndProcCtrl ); end; {$ENDIF ASM_VERSION} {$ENDIF GDI} + {$IFDEF _X_} {$IFDEF GTK} -function getLabelCaption( L: PControl ): KOLString; -begin +FUNCTION getLabelCaption( L: PControl ): KOLString; +BEGIN L.fCaption := gtk_label_get_text( Pointer( L.fCaptionHandle ) ); Result := L.fCaption; -end; +END; -procedure setLabelCaption( L: PControl; const Value: KOLString ); -begin +PROCEDURE setLabelCaption( L: PControl; const Value: KOLString ); +BEGIN L.fCaption := Value; gtk_label_set_text( Pointer( L.fCaptionHandle ), PAnsiChar( String( Value ) ) ); -end; +END; -function _NewControl( AParent: PControl; ControlClassName: PAnsiChar; +FUNCTION _NewControl( AParent: PControl; ControlClassName: PAnsiChar; Style: DWORD; Ctl3D: Boolean; widget: PGtkWidget; need_eventbox: Boolean ): PControl; -var Rect: TRect; -begin +VAR Rect: TRect; +BEGIN Result := _NewWindowed( AParent, ControlClassName, widget, need_eventbox ); Result.fIsControl := True; Result.fVerticalAlign := vaTop; Result.fVisible := (Style and WS_VISIBLE) <> 0; Result.fTabstop := (Style and WS_TABSTOP) <> 0; - if (AParent <> nil) then - begin - with Rect do - begin + IF (AParent <> nil) THEN + BEGIN + WITH Rect DO + BEGIN Left := AParent.fMargin + AParent.fClientLeft; Top := AParent.fMargin + AParent.fClientTop; - end; + END; Inc( AParent.ParentForm.fTabOrder ); Result.fTabOrder := AParent.ParentForm.fTabOrder; {$IFDEF GDI} Result.fCursor := AParent.fCursor; {$ENDIF GDI} //gtk_container_add( GTK_CONTAINER( AParent.fHandle ), Result.fHandle ); - end; + END; {with Rect do begin Right := Left + 64; @@ -30508,44 +30428,41 @@ begin Result.BoundsRect := Rect;} Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ]; {$IFDEF GDI} - if Result.fCtl3D then - begin + IF Result.fCtl3D THEN + BEGIN Result.fStyle := Result.fStyle and not WS_BORDER; Result.fExStyle := Result.fExStyle or WS_EX_CLIENTEDGE; - end; - if (Style and WS_TABSTOP) <> 0 then - begin + END; + IF (Style and WS_TABSTOP) <> 0 THEN + BEGIN Form := Result.ParentForm; - if Form <> nil then - if Form.FCurrentControl = nil then + IF Form <> nil THEN + IF Form.FCurrentControl = nil THEN Form.FCurrentControl := Result; - end; + END; Result.fMenu := CtlIdCount; Inc( CtlIdCount ); Result.AttachProc( WndProcCtrl ); {$ENDIF GDI} -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[END _NewControl] {$IFDEF WIN_GDI} //===================== Button ========================// -//[function TControl.SetButtonIcon] function TControl.SetButtonIcon(aIcon: HIcon): PControl; var PrevImg: THandle; begin Style := Style or BS_ICON; - fButtonIcon := aIcon; + DF.fButtonIcon := aIcon; PrevImg := Perform( BM_SETIMAGE, IMAGE_ICON, aIcon ); if PrevImg <> 0 then DeleteObject( PrevImg ); Result := @ Self; end; -//[function TControl.SetButtonBitmap] function TControl.SetButtonBitmap(aBmp: HBitmap): PControl; var PrevImg: THandle; begin @@ -30557,7 +30474,6 @@ begin end; {$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER} -//[function WndProcBtnReturnClick] function WndProcBtnReturnClick( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin Result := FALSE; @@ -30568,7 +30484,6 @@ end; {$ENDIF} {$IFNDEF BUTTON_DBLCLICK} -//[function WndProcBtnDblClkAsClk] function WndProcBtnDblClkAsClk( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin Result := FALSE; @@ -30577,7 +30492,6 @@ begin end; {$ENDIF} -//[function AutoMinimizeApplet] function AutoMinimizeApplet(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; begin if (msg.Message=WM_SYSCOMMAND) and ((msg.wParam and not 15)=SC_MINIMIZE) then begin @@ -30588,10 +30502,12 @@ begin end; {$IFDEF USE_CONSTRUCTORS} -//[function NewButton] function NewButton( AParent: PControl; const Caption: KOLString ): PControl; begin new( Result, CreateButton( AParent, Caption ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Button'; + {$ENDIF} end; {$ELSE USE_CONSTRUCTORS} @@ -30599,24 +30515,32 @@ end; const ButtonClass: array[ 0..6 ] of KOLChar = ( 'B','U','T','T','O','N',#0 ); //22{$ENDIF ASM_VERSION} -//[FUNCTION NewButton] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewButton( AParent: PControl; const Caption: KOLString ): PControl; begin Result := _NewControl( AParent, 'BUTTON', WS_VISIBLE or WS_CHILD or BS_NOTIFY or - BS_PUSHLIKE or WS_TABSTOP, False, @ButtonActions ); + BS_PUSHLIKE or WS_TABSTOP, False, + {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed + {$ELSE} @ButtonActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Button'; + {$ENDIF} + Result.aAutoSzX := 14; + Result.aAutoSzY := 6; {$IFDEF BUTTON_DBLCLICK} Result.ClsStyle := Result.ClsStyle - CS_DBLCLKS; {$ENDIF} - Result.fIgnoreDefault := TRUE; //Result.fCtl3D := TRUE; with Result.fBoundsRect do Bottom := Top + 22; Result.fTextAlign := taCenter; Result.Caption := Caption; - Result.fIsButton := TRUE; + {$IFDEF USE_FLAGS} + Result.fFlagsG5 := Result.fFlagsG5 + [G5_IsButton, G5_IgnoreDefault]; + {$ELSE} Result.fIsButton := TRUE; + Result.fIgnoreDefault := TRUE; + {$ENDIF} {$IFNDEF SMALLEST_CODE} {$IFNDEF BUTTON_DBLCLICK} Result.AttachProc( WndProcBtnDblClkAsClk ); @@ -30626,30 +30550,28 @@ begin Result.AttachProc( WndProcBtnReturnClick ); {$ENDIF} {$IFDEF GRAPHCTL_XPSTYLES} - Result.fClassicTransparent := Result.fTransparent; - Attach_WM_THEMECHANGED(Result); - XP_Themes_For_BitBtn(Result); + Attach_WM_THEMECHANGED( Result, XP_Themes_For_BitBtn ); {$ENDIF} end; {$ENDIF ASM_VERSION} -//[END NewButton] {$ENDIF USE_CONSTRUCTORS} {$ENDIF WIN_GDI} + {$IFDEF _X_} {$IFDEF GTK} -const - HorAlignments: array[ TTextAlign ] of Single = ( {taLeft} 0, {taRight} 1, {taCenter} 0.5 ); - VerAlignments: array[ TVerticalAlign ] of Single = ( {vaCenter} 0.5, {vaTop} 0, {vaBottom} 1 ); +CONST + HorAlignments: ARRAY[ TTextAlign ] of Single = ( {taLeft} 0, {taRight} 1, {taCenter} 0.5 ); + VerAlignments: ARRAY[ TVerticalAlign ] of Single = ( {vaCenter} 0.5, {vaTop} 0, {vaBottom} 1 ); -procedure ButtonSetTextAlign( Self_: PControl ); -begin +PROCEDURE ButtonSetTextAlign( Self_: PControl ); +BEGIN gtk_button_set_alignment( GTK_BUTTON( Self_.fHandle ), HorAlignments[ Self_.fTextAlign ], VerAlignments[ Self_.fVerticalAlign ] ); -end; +END; -function NewButton( AParent: PControl; const Caption: KOLString ): PControl; -begin +FUNCTION NewButton( AParent: PControl; const Caption: KOLString ): PControl; +BEGIN Result := _NewControl( AParent, 'BUTTON', WS_VISIBLE or WS_CHILD or BS_NOTIFY or BS_PUSHLIKE or WS_TABSTOP, False, @@ -30670,16 +30592,14 @@ begin Result.fCaption := Caption; Result.fIsButton := TRUE; Result.fSetTextAlign := ButtonSetTextAlign; -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} //----------------- BitBtn ----------------------- -//[FUNCTION WndProc_DrawItem] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProc_DrawItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; var DI: PDrawItemStruct; @@ -30702,29 +30622,26 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END WndProc_DrawItem] -//[function ExcludeAmpersands] function ExcludeAmpersands( Self_: PControl; const S: KOLString ): KOLString; var I: Integer; begin Result := S; - if not Self_.FBitBtnDrawMnemonic then Exit; + if not Self_.DF.fBitBtnDrawMnemonic then Exit; for I := Length( Result ) downto 1 do begin - if Result[ I ] = '&' then - Delete( Result, I, 1 ); + if Result[ I ] = '&' then + Delete( Result, I, 1 ); end; end; -//[procedure BitBtnExtDraw] procedure BitBtnExtDraw( Self_: PControl; DC: HDC; X, Y: Integer; const R: TRect; const CapText, CapTxtOrig: KOLString; Color: TColor ); var I, J, W, H: Integer; Sz: TSize; Pen, OldPen: HPen; begin - if not Self_.FBitBtnDrawMnemonic then Exit; + if not Self_.DF.fBitBtnDrawMnemonic then Exit; J := 0; for I := 1 to Length( CapTxtOrig ) do begin @@ -30736,7 +30653,7 @@ begin W := Sz.cx; Windows.GetTextExtentPoint32( DC, '_', 1, Sz ); // A/W KOL_ANSI H := Sz.cy - 1; - Windows.GetTextExtentPoint32( DC, @ CapTxtOrig[ I + 1 ], 1, Sz ); + Windows.GetTextExtentPoint32( DC, @ CapTxtOrig[ I + 1 ], 1, Sz ); Windows.MoveToEx( DC, X + W, Y + H, nil ); Pen := CreatePen( PS_SOLID, 0, Color2RGB( Color ) ); @@ -30750,52 +30667,45 @@ begin end; end; -//[procedure TControl.SetBitBtnDrawMnemonic] procedure TControl.SetBitBtnDrawMnemonic(const Value: Boolean); begin - FBitBtnDrawMnemonic := Value; - FBitBtnGetCaption := ExcludeAmpersands; - FBitBtnExtDraw := BitBtnExtDraw; + DF.fBitBtnDrawMnemonic := Value; + DF.FBitBtnGetCaption := ExcludeAmpersands; + DF.FBitBtnExtDraw := BitBtnExtDraw; Invalidate; end; -//[function TControl.GetBitBtnImgIdx] function TControl.GetBitBtnImgIdx: Integer; begin - Result := LoWord( fGlyphCount ); + Result := LoWord( DF.fGlyphCount ); end; -//[procedure TControl.SetBitBtnImgIdx] procedure TControl.SetBitBtnImgIdx(const Value: Integer); begin - if not( bboImageList in fBitBtnOptions ) then Exit; - fGlyphCount := HiWord( fGlyphCount ) or (Value and $FFFF); + if not( bboImageList in DF.fBitBtnOptions ) then Exit; + DF.fGlyphCount := HiWord( DF.fGlyphCount ) or (Value and $FFFF); Invalidate; end; -//[function TControl.GetBitBtnImageList] function TControl.GetBitBtnImageList: THandle; begin Result := 0; - if bboImageList in fBitBtnOptions then - Result := fGlyphBitmap; + if bboImageList in DF.fBitBtnOptions then + Result := DF.fGlyphBitmap; end; -//[procedure TControl.SetBitBtnImageList] procedure TControl.SetBitBtnImageList(const Value: THandle); begin - fGlyphBitmap := Value; - if Value <> 0 then + DF.fGlyphBitmap := Value; + if Value <> 0 then begin - fBitBtnOptions := fBitBtnOptions + [ bboImageList ]; - ImageList_GetIconSize( Value, fGlyphWidth, fGlyphHeight ); - end - else - fBitBtnOptions := fBitBtnOptions - [ bboImageList ]; + include( DF.fBitBtnOptions, bboImageList ); + ImageList_GetIconSize( Value, DF.fGlyphWidth, DF.fGlyphHeight ); + end else + exclude( DF.fBitBtnOptions, bboImageList ); Invalidate; end; -//[FUNCTION WndProcBitBtn] {$IFDEF ASM_noVERSION} // remove &-s from view //+ TextShift & if Y < 0 then Y := 0; // + glyph + TextShift if not glyphOver // timer when RepeatInterval set function WndProcBitBtn( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; @@ -30830,7 +30740,11 @@ asm JZ @@not1 JMP @@1 @@fixed_in_options: + {$IFDEF USE_FLAGS} + TEST [EDI].TControl.fFlagsG4, 1 shl G4_Checked + {$ELSE} TEST byte ptr [EDI].TControl.fChecked, 1 + {$ENDIF} JZ @@not1 @@1: INC EBX @@not1: @@ -30842,7 +30756,11 @@ asm {$IFDEF PARANOIA} DB $A8, ODS_FOCUS {$ELSE} TEST AL, ODS_FOCUS {$ENDIF} JZ @@not3 MOV BL, 3 -@@not3: CMP [EDI].TControl.fMouseInControl, BH +@@not3: {$IFDEF USE_FLAGS} + TEST [EDI].TControl.fFlagsG3, 1 shl G3_MouseInCtl + {$ELSE} + CMP [EDI].TControl.fMouseInControl, BH + {$ENDIF} JZ @@not4 TEST EBX, EBX JZ @@4 @@ -30850,8 +30768,10 @@ asm JNZ @@not4 @@4: MOV BL, 4 @@not4: MOV ECX, [EDI].TControl.fOnBitBtnDraw.TMethod.Code + {$IFDEF NIL_EVENTS} TEST ECX, ECX JZ @@noOnBitBtnDraw + {$ENDIF} //JECXZ @@noOnBitBtnDraw MOV EAX, [EDI].TControl.fCanvas PUSH EAX @@ -30896,10 +30816,17 @@ asm XOR ECX, ECX JMP @@noFlat @@noDefaultBorder: - MOVZX ECX, [EDI].TControl.fFlat - JECXZ @@noFlat - AND CL, [EDI].TControl.fMouseInControl - JZ @@noborder + {$IFDEF USE_FLAGS} + TEST [EDI].TControl.fFlagsG3, 1 shl G3_Flat + JZ @@noFlat + TEST [EDI].TControl.fFlagsG3, 1 shl G3_MouseInCtl + JZ @@noborder + {$ELSE} + MOVZX ECX, [EDI].TControl.fFlat + JECXZ @@noFlat + AND CL, [EDI].TControl.fMouseInControl + JZ @@noborder + {$ENDIF} @@noFlat: TEST byte ptr [ESI].TDrawItemStruct.itemState, ODS_SELECTED MOV CL, {BDR_SUNKENOUTER or} BDR_SUNKENINNER @@ -31255,6 +31182,15 @@ asm JMP @@invalidate @@noWM_LBUTTONDOWN: + CMP word ptr [EDX].TMsg.message, WM_LBUTTONUP + JE @@doKill1 + CMP word ptr [EDX].TMsg.message, WM_KEYUP + JNE @@noWM_LBUTTONUP + PUSH 1 + PUSH [EBX].TControl.fHandle + CALL KillTimer + +@@noWM_LBUTTONUP: CMP word ptr [EDX].TMsg.message, WM_TIMER JNZ @@noWM_TIMER @@ -31274,9 +31210,15 @@ asm @@fixed_proc: TEST byte ptr [EBX].TControl.fBitBtnOptions, 8 // bboFixed JZ @@not_fixed + {$IFDEF USE_FLAGS} + XOR [EBX].TControl.fFlagsG4, 1 shl G4_Checked + {$ELSE} XOR [EBX].TControl.fChecked, 1 + {$ENDIF} MOV ECX, [EBX].TControl.fOnChange.TMethod.Code + {$IFDEF NIL_EVENTS} JECXZ @@not_fixed + {$ENDIF} MOV EAX, [EBX].TControl.fOnChange.TMethod.Data MOV EDX, EBX JMP ECX @@ -31319,7 +31261,9 @@ begin Result := True; Rslt := 1; DIS := Pointer( Msg.lParam ); - IsDown := (DIS.itemState and ODS_SELECTED <> 0) or Self_.fChecked; + IsDown := (DIS.itemState and ODS_SELECTED <> 0) or + {$IFDEF USE_FLAGS} (G4_Checked in Self_.fFlagsG4) + {$ELSE} Self_.fChecked {$ENDIF}; IsDefault := DIS.itemState and ODS_FOCUS <> 0; IsDisabled := DIS.itemState and ODS_DISABLED <> 0; G := 0; @@ -31327,60 +31271,66 @@ begin if IsDisabled then G := {$IFDEF BITBTN_DISABLEDGLYPH2} 2 {$ELSE} 1 {$ENDIF}; if (G = 0) and IsDefault then G := 3; if ((G = 0) or (G = 3)) and Self_.MouseInControl then G := 4; - if Assigned( Self_.fOnBitBtnDraw ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnBitBtnDraw ) then + {$ENDIF} begin - if Assigned( Self_.fCanvas ) then - Self_.fCanvas.SetHandle( DIS.hDC ); - Handled := Self_.fOnBitBtnDraw( Self_, G ); - if Assigned( Self_.fCanvas ) then - Self_.fCanvas.SetHandle( 0 ); - if Handled then Exit; + if ( Self_.fCanvas <> nil ) then + Self_.fCanvas.SetHandle( DIS.hDC ); + Handled := Self_.EV.fOnBitBtnDraw( Self_, G ); + if ( Self_.fCanvas <> nil ) then + Self_.fCanvas.SetHandle( 0 ); + if Handled then Exit; end; - if not ( bboNoBorder in Self_.fBitBtnOptions ) then + if not ( bboNoBorder in Self_.DF.fBitBtnOptions ) then begin - if IsDefault and not( bboFocusRect in Self_.fBitBtnOptions ) then - begin - Windows.FrameRect( DIS.hDC, DIS.rcItem, GetStockObject( {BLACK_BRUSH} DKGRAY_BRUSH ) ); - InflateRect( DIS.rcItem, -1, -1 ); - end; - if Self_.fFlat then - begin - if IsDown then - Flags := BDR_RAISEDINNER - else - Flags := 0; //EDGE_ETCHED; - DrawEdge( DIS.hDC, DIS.rcItem, Flags, BF_FLAT or BF_RECT ); - //InflateRect( DIS.rcItem, -1, -1 ); - end; - if not Self_.fFlat or Self_.fMouseInControl or IsDefault then - begin - if IsDown then - Flags := BDR_SUNKENOUTER or BDR_SUNKENINNER - else - Flags := BDR_RAISEDOUTER or BDR_RAISEDINNER; - DrawEdge( DIS.hDC, DIS.rcItem, Flags, BF_ADJUST or BF_RECT ); - InflateRect( DIS.rcItem, -1, -1 ); - end; + if IsDefault and not( bboFocusRect in Self_.DF.fBitBtnOptions ) then + begin + Windows.FrameRect( DIS.hDC, DIS.rcItem, GetStockObject( {BLACK_BRUSH} DKGRAY_BRUSH ) ); + InflateRect( DIS.rcItem, -1, -1 ); + end; + if {$IFDEF USE_FLAGS} G3_Flat in Self_.fFlagsG3 + {$ELSE} Self_.fFlat {$ENDIF} then + begin + if IsDown then + Flags := BDR_RAISEDINNER + else + Flags := 0; //EDGE_ETCHED; + DrawEdge( DIS.hDC, DIS.rcItem, Flags, BF_FLAT or BF_RECT ); + //InflateRect( DIS.rcItem, -1, -1 ); + end; + if {$IFDEF USE_FLAGS} not(G3_Flat in Self_.fFlagsG3) + {$ELSE} not Self_.fFlat {$ENDIF} + or {$IFDEF USE_FLAGS} (G3_MouseInCtl in Self_.fFlagsG3) + {$ELSE} Self_.fMouseInControl {$ENDIF} or IsDefault then + begin + if IsDown then + Flags := BDR_SUNKENOUTER or BDR_SUNKENINNER + else + Flags := BDR_RAISEDOUTER or BDR_RAISEDINNER; + DrawEdge( DIS.hDC, DIS.rcItem, Flags, BF_ADJUST or BF_RECT ); + InflateRect( DIS.rcItem, -1, -1 ); + end; end; TxRect := DIS.rcItem; - if Self_.fGlyphBitmap <> 0 then + if Self_.DF.fGlyphBitmap <> 0 then begin - ImgW := Self_.fGlyphWidth; - ImgH := Self_.fGlyphHeight; - if (ImgW > 0) and (ImgH > 0) then - begin - OutW := ImgW; - OutH := ImgH; - W := DIS.rcItem.Right - DIS.rcItem.Left; - H := DIS.rcItem.Bottom - DIS.rcItem.Top; - X := DIS.rcItem.Left; - Y := DIS.rcItem.Top; - if isDown and (Self_.fGlyphLayout <> glyphOver) then + ImgW := Self_.DF.fGlyphWidth; + ImgH := Self_.DF.fGlyphHeight; + if (ImgW > 0) and (ImgH > 0) then begin - Inc( X, Self_.TextShiftX ); - Inc( Y, Self_.TextShiftY ); - end; - case Self_.fGlyphLayout of + OutW := ImgW; + OutH := ImgH; + W := DIS.rcItem.Right - DIS.rcItem.Left; + H := DIS.rcItem.Bottom - DIS.rcItem.Top; + X := DIS.rcItem.Left; + Y := DIS.rcItem.Top; + if isDown and (Self_.DF.fGlyphLayout <> glyphOver) then + begin + Inc( X, Self_.TextShiftX ); + Inc( Y, Self_.TextShiftY ); + end; + case Self_.DF.fGlyphLayout of glyphLeft: begin Y := Y + (H - OutH) div 2; @@ -31408,75 +31358,80 @@ begin X := X + (W - OutW) div 2; Y := Y + (H - OutH) div 2; end; - end; - if X < DIS.rcItem.Left then - X := DIS.rcItem.Left; - if Y < DIS.rcItem.Top then - Y := DIS.rcItem.Top; - if X + OutW > DIS.rcItem.Right then - OutW := DIS.rcItem.Right - X; - if Y + OutH > DIS.rcItem.Bottom then - OutH := DIS.rcItem.Bottom - Y; - - if bboImageList in Self_.fBitBtnOptions then - begin - I := LoWord( Self_.fGlyphCount ); - if (HiWord( Self_.fGlyphCount ) > G) then - I := I + G; - Flags := 0; // ILD_NORMAL - Blend := 0; - if not Self_.fTransparent then - Bk := Color2RGB( Self_.fColor ) - else - begin - Bk := Integer(CLR_NONE); - Flags := ILD_TRANSPARENT; - end; - if HiWord( Self_.fGlyphCount ) = 1 then - begin - Blend := Integer(CLR_DEFAULT); - if IsDefault then - Flags := Flags or ILD_BLEND25; - end; - ImageList_DrawEx( Self_.fGlyphBitmap, I, DIS.hDC, X, Y, 0, 0, - Bk, Blend, Flags ); - end - else - begin - DC := CreateCompatibleDC( 0 ); - OldBmp := SelectObject( DC, Self_.fGlyphBitmap ); - - I := 0; - if Self_.fGlyphCount > G then - I := I + G * ImgW; - StretchBlt( DIS.hDC, X, Y, OutW, OutH, DC, I, 0, ImgW, ImgH, SRCCOPY ); - - SelectObject( DC, OldBmp ); - DeleteDC( DC ); end; - end; + if X < DIS.rcItem.Left then + X := DIS.rcItem.Left; + if Y < DIS.rcItem.Top then + Y := DIS.rcItem.Top; + if X + OutW > DIS.rcItem.Right then + OutW := DIS.rcItem.Right - X; + if Y + OutH > DIS.rcItem.Bottom then + OutH := DIS.rcItem.Bottom - Y; + + if bboImageList in Self_.DF.fBitBtnOptions then + begin + I := LoWord( Self_.DF.fGlyphCount ); + if (HiWord( Self_.DF.fGlyphCount ) > G) then + I := I + G; + Flags := 0; // ILD_NORMAL + Blend := 0; + if {$IFDEF USE_FLAGS} not( G2_Transparent in Self_.fFlagsG2 ) + {$ELSE} not Self_.fTransparent {$ENDIF} then + Bk := Color2RGB( Self_.fColor ) + else + begin + Bk := Integer(CLR_NONE); + Flags := ILD_TRANSPARENT; + end; + if HiWord( Self_.DF.fGlyphCount ) = 1 then + begin + Blend := Integer(CLR_DEFAULT); + if IsDefault then + Flags := Flags or ILD_BLEND25; + end; + ImageList_DrawEx( Self_.DF.fGlyphBitmap, I, DIS.hDC, X, Y, 0, 0, + Bk, Blend, Flags ); + end + else + begin + DC := CreateCompatibleDC( 0 ); + OldBmp := SelectObject( DC, Self_.DF.fGlyphBitmap ); + + I := 0; + if Self_.DF.fGlyphCount > G then + I := I + G * ImgW; + StretchBlt( DIS.hDC, X, Y, OutW, OutH, DC, I, 0, ImgW, ImgH, SRCCOPY ); + + SelectObject( DC, OldBmp ); + DeleteDC( DC ); + end; + end; end; - if not (bboNoCaption in Self_.fBitBtnOptions) then + if not (bboNoCaption in Self_.DF.fBitBtnOptions) then if (TxRect.Right > TxRect.Left) and (TxRect.Bottom > TxRect.Top) then begin CapText := Self_.Caption; CapTxtOrig := CapText; /////////////////////////// added 19 Nov 2001 - if Assigned( Self_.FBitBtnGetCaption ) then - CapText := Self_.FBitBtnGetCaption( Self_, CapText ); //////////// + //{$IFDEF NIL_EVENTS} + if Assigned( Self_.DF.FBitBtnGetCaption ) then + //{$ENDIF} + CapText := Self_.DF.FBitBtnGetCaption( Self_, CapText ); //////////// Bk := 0; Blend := 0; Flags := ETO_CLIPPED; - if Self_.fTransparent or (Self_.fGlyphLayout = glyphOver) then - Bk := SetBkMode( DIS.hDC, TRANSPARENT ) + if {$IFDEF USE_FLAGS} (G2_Transparent in Self_.fFlagsG2) + {$ELSE} Self_.fTransparent {$ENDIF} + or (Self_.DF.fGlyphLayout = glyphOver) then + Bk := SetBkMode( DIS.hDC, TRANSPARENT ) else begin - Flags := Flags or ETO_OPAQUE; - Blend := SetBkColor( DIS.hDC, Color2RGB( Self_.fColor ) ); + Flags := Flags or ETO_OPAQUE; + Blend := SetBkColor( DIS.hDC, Color2RGB( Self_.fColor ) ); end; // Returned previous BkMode is either OPAQUE=1 or TRANSPARENT=2 OldFont := 0; - if assigned( Self_.fFont ) then - OldFont := SelectObject( DIS.hDC, Self_.fFont.Handle ); + if ( Self_.fFont <> nil ) then + OldFont := SelectObject( DIS.hDC, Self_.fFont.Handle ); OldTextColor := SetTextColor( DIS.hDC, Color2RGB( Self_.fTextColor ) ); {$IFDEF UNICODE_CTRLS}Windows.GetTextExtentPoint32W @@ -31509,7 +31464,7 @@ begin PAnsiChar( CapText ), Length( CapText ), nil ); {$ENDIF} - if bboFocusRect in Self_.fBitBtnOptions then + if bboFocusRect in Self_.DF.fBitBtnOptions then if IsDefault then begin FocusRect := TxRect; @@ -31517,9 +31472,11 @@ begin Windows.DrawFocusRect( DIS.hDC, FocusRect ); end; - if Assigned( Self_.FBitBtnExtDraw ) then // to provide underlying mnemonic characters - Self_.FBitBtnExtDraw( Self_, DIS.hDC, X, Y, TxRect, CapText, CapTxtOrig, - OldTextColor ); ///////////////////////////////// + //{$IFDEF NIL_EVENTS} + if Assigned( Self_.DF.FBitBtnExtDraw ) then // to provide underlying mnemonic characters + //{$ENDIF} + Self_.DF.FBitBtnExtDraw( Self_, DIS.hDC, X, Y, TxRect, CapText, CapTxtOrig, + OldTextColor ); ///////////////////////////////// SetTextColor( DIS.hDC, OldTextColor ); if OldFont <> 0 then @@ -31533,13 +31490,19 @@ begin end; if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_KEYDOWN) and (Msg.wParam = 32) then begin - if bboFixed in Self_.fBitBtnOptions then + if bboFixed in Self_.DF.fBitBtnOptions then begin - Self_.fChecked := not Self_.fChecked; - if Assigned( Self_.fOnChange ) then - Self_.fOnChange( Self_ ); + {$IFDEF USE_FLAGS} + if G4_Checked in Self_.fFlagsG4 then + exclude( Self_.fFlagsG4, G4_Checked ) + else include( Self_.fFlagsG4, G4_Checked ); + {$ELSE} Self_.fChecked := not Self_.fChecked; {$ENDIF} + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnChange ) then + {$ENDIF} + Self_.EV.fOnChange( Self_ ); end; - if Self_.fRepeatInterval > 0 then + if Self_.DF.fRepeatInterval > 0 then begin if Msg.message <> WM_KEYDOWN then SetTimer( Self_.fHandle, 1, 400, nil ); @@ -31547,9 +31510,9 @@ begin end; end; - if (Msg.message = WM_LBUTTONUP) or (Msg.message = WM_KEYUP) then + if Msg.message = WM_LBUTTONUP then begin - if Self_.fRepeatInterval > 0 then + if Self_.DF.fRepeatInterval > 0 then KillTimer( Self_.fHandle, 1 ); end; @@ -31559,32 +31522,37 @@ begin if Msg.message = WM_TIMER then begin KillTimer( Self_.fHandle, 1 ); - if bboFixed in Self_.fBitBtnOptions then + if bboFixed in Self_.DF.fBitBtnOptions then begin - Self_.fChecked := not Self_.fChecked; - if Assigned( Self_.fOnChange ) then - Self_.fOnChange( Self_ ); + {$IFDEF USE_FLAGS} + if G4_Checked in Self_.fFlagsG4 then + exclude( Self_.fFlagsG4, G4_Checked ) + else include( Self_.fFlagsG4, G4_Checked ); + {$ELSE} Self_.fChecked := not Self_.fChecked; {$ENDIF} + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnChange ) then + {$ENDIF} + Self_.EV.fOnChange( Self_ ); end; Self_.DoClick; - SetTimer( Self_.fHandle, 1, Self_.fRepeatInterval, nil ); + SetTimer( Self_.fHandle, 1, Self_.DF.fRepeatInterval, nil ); Self_.Invalidate; end; 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:BitBtn'; + {$ENDIF} end; -//[END NewBitBtn] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewBitBtn] {$IFDEF ASM_noVERSION} // todo: first correct asm version, then remove {$ELSE ASM_VERSION} //Pascal function NewBitBtn( AParent: PControl; const Caption: KOLString; @@ -31596,84 +31564,93 @@ var f: DWORD; begin f := WS_VISIBLE or WS_CHILD or BS_OWNERDRAW or WS_TABSTOP or BS_NOTIFY; - Result := _NewControl( AParent, 'BUTTON', f, False, @ButtonActions ); - Result.fIgnoreDefault := TRUE; - Result.fIsButton := TRUE; - Result.fIsBitBtn := TRUE; - Result.fCommandActions.aAutoSzX := 8; - Result.fCommandActions.aAutoSzY := 8; - Result.fBitBtnOptions := Options; - Result.fGlyphLayout := Layout; - Result.fGlyphBitmap := GlyphBitmap; + Result := _NewControl( AParent, 'BUTTON', f, False, + {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed + {$ELSE} @ButtonActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:BitBtn'; + {$ENDIF} + {$IFDEF USE_FLAGS} + Result.fFlagsG5 := Result.fFlagsG5 + + [G5_IsButton, G5_IsBitBtn, G5_IgnoreDefault]; + {$ELSE} Result.fIsButton := TRUE; + Result.fIsBitBtn := TRUE; + Result.fIgnoreDefault := TRUE; + {$ENDIF} + Result.aAutoSzX := 8; + Result.aAutoSzY := 8; + Result.DF.fBitBtnOptions := Options; + Result.DF.fGlyphLayout := Layout; + Result.DF.fGlyphBitmap := GlyphBitmap; with Result.fBoundsRect do begin - Bottom := Top + 22; - W := 0; H := 0; - if GlyphBitmap <> 0 then - begin - if bboImageList in Options then - ImageList_GetIconSize( GlyphBitmap, W, H ) - else - begin - if GetObject( GlyphBitmap, Sizeof(B), @B ) > 0 then + Bottom := Top + 22; + W := 0; H := 0; + if GlyphBitmap <> 0 then + begin + if bboImageList in Options then + ImageList_GetIconSize( GlyphBitmap, W, H ) + else begin - W := B.bmiHeader.biWidth; - H := B.bmiHeader.biHeight; - if GlyphCount = 0 then - GlyphCount := W div H; - if GlyphCount > 1 then - W := W div GlyphCount; + if GetObject( GlyphBitmap, Sizeof(B), @B ) > 0 then + begin + W := B.bmiHeader.biWidth; + H := B.bmiHeader.biHeight; + if GlyphCount = 0 then + GlyphCount := W div H; + if GlyphCount > 1 then + W := W div GlyphCount; + end; + end; + if W > 0 then + begin + if (Caption = '') or (Layout = glyphOver) then + begin + Right := Left + W; + Result.aAutoSzX := 0; + end + else + if Layout in [ glyphLeft, glyphRight ] then + begin + Right := Right + W; + Inc( Result.aAutoSzX, W ); + end; + end; + if H > 0 then + begin + if Layout in [ glyphTop, glyphBottom ] then + begin + Bottom := Bottom + H; + Inc( Result.aAutoSzY, H ); + end + else + begin + Bottom := Top + H; + Result.aAutoSzY := 0; + end; + end; + if not ( bboNoBorder in Options ) then + begin + if W > 0 then + begin + Inc( Right, 4 ); + if Result.aAutoSzX > 0 then + Inc( Result.aAutoSzX, 4 ); + end; + if H > 0 then + begin + Inc( Bottom, 4 ); + if Result.aAutoSzY > 0 then + Inc( Result.aAutoSzY, 4 ); + end; end; - end; - if W > 0 then - begin - if (Caption = '') or (Layout = glyphOver) then - begin - Right := Left + W; - Result.fCommandActions.aAutoSzX := 0; - end - else - if Layout in [ glyphLeft, glyphRight ] then - begin - Right := Right + W; - Inc( Result.fCommandActions.aAutoSzX, W ); - end; end; - if H > 0 then - begin - if Layout in [ glyphTop, glyphBottom ] then - begin - Bottom := Bottom + H; - Inc( Result.fCommandActions.aAutoSzY, H ); - end - else - begin - Bottom := Top + H; - Result.fCommandActions.aAutoSzY := 0; - end; - end; - if not ( bboNoBorder in Options ) then - begin - if W > 0 then - begin - Inc( Right, 4 ); - if Result.fCommandActions.aAutoSzX > 0 then - Inc( Result.fCommandActions.aAutoSzX, 4 ); - end; - if H > 0 then - begin - Inc( Bottom, 4 ); - if Result.fCommandActions.aAutoSzY > 0 then - Inc( Result.fCommandActions.aAutoSzY, 4 ); - end; - end; - end; - Result.fGlyphWidth := W; - Result.fGlyphHeight := H; + Result.DF.fGlyphWidth := W; + Result.DF.fGlyphHeight := H; end; - Result.fGlyphCount := GlyphCount; - if AParent <> nil then - AParent.AttachProc( WndProc_DrawItem ); + Result.DF.fGlyphCount := GlyphCount; + if AParent <> nil then + AParent.AttachProc( WndProc_DrawItem ); Result.AttachProc( WndProcBitBtn ); Result.fTextAlign := taCenter; Result.Caption := Caption; @@ -31681,31 +31658,27 @@ begin Result.AttachProc( WndProcBtnReturnClick ); {$ENDIF} -{$IFDEF GRAPHCTL_XPSTYLES} - Result.fClassicTransparent := Result.fTransparent; - Attach_WM_THEMECHANGED(Result); - XP_Themes_For_BitBtn(Result); + {$IFDEF GRAPHCTL_XPSTYLES} + Attach_WM_THEMECHANGED(Result, XP_Themes_For_BitBtn); {$ENDIF} 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:CheckBox'; + {$ENDIF} end; -//[END NewCheckbox] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewCheckbox] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl; begin Result := NewButton( AParent, Caption ); @@ -31713,32 +31686,47 @@ begin begin Right := Left + 72; end; - Result.fStyle := WS_VISIBLE or WS_CHILD or + Result.fStyle.Value := WS_VISIBLE or WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP or BS_NOTIFY; - Result.fCommandActions.aAutoSzX := 24; + Result.aAutoSzX := 24; {$IFDEF GRAPHCTL_XPSTYLES} - Result.fClassicTransparent := Result.fTransparent; - Attach_WM_THEMECHANGED(Result); - XP_Themes_For_CheckBox(Result); + Attach_WM_THEMECHANGED(Result, XP_Themes_For_CheckBox ); {$ENDIF} end; {$ENDIF ASM_VERSION} -//[END NewCheckbox] {$ENDIF USE_CONSTRUCTORS} -//[function NewCheckBox3State] function NewCheckBox3State( AParent: PControl; const Caption: KOLString ): PControl; begin Result := NewCheckbox( AParent, Caption ); - Result.fStyle := Result.fStyle and not BS_AUTOCHECKBOX or BS_AUTO3STATE; + Result.fStyle.Value := Result.fStyle.Value and not BS_AUTOCHECKBOX or BS_AUTO3STATE; end; //===================== Radiobox ========================// -//[FUNCTION ClickRadio] {$IFDEF ASM_VERSION} +procedure ClickRadio( Sender:PObj ); +asm + PUSH EBX + MOV EBX, [EAX].TControl.fParent + TEST EBX, EBX + JZ @@exit + PUSH [EAX].TControl.fMenu + MOV EAX, EBX + MOV EDX, offset[RADIO_LAST] + CALL TControl.Get_Prop_Int + PUSH EAX + MOV EAX, EBX + MOV EDX, offset[RADIO_1ST] + CALL TControl.Get_Prop_Int + PUSH EAX + PUSH [EBX].TControl.fHandle + CALL CheckRadioButton +@@exit: + POP EBX +end; {$ELSE ASM_VERSION} //Pascal procedure ClickRadio( Sender:PObj ); var Self_:PControl; @@ -31746,48 +31734,43 @@ begin Self_ := PControl( Sender ); if Self_.FParent <> nil then CheckRadioButton( Self_.fParent.fHandle, - Self_.fParent.fRadio1st, - Self_.fParent.fRadioLast, + Self_.fParent.PropInt[ @RADIO_1ST ], + Self_.fParent.PropInt[ @RADIO_LAST ], Self_.fMenu ); 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Radiobox'; + {$ENDIF} end; -//[END NewRadiobox] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewRadiobox] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewRadiobox( AParent: PControl; const Caption: KOLString ): PControl; begin Result := NewCheckbox( AParent, Caption ); - Result.fStyle := WS_VISIBLE or WS_CHILD or + Result.fStyle.Value := WS_VISIBLE or WS_CHILD or BS_RADIOBUTTON or WS_TABSTOP or WS_GROUP or BS_NOTIFY; - Result.fControlClick := ClickRadio; + Result.PP.fControlClick := ClickRadio; if AParent <> nil then begin - AParent.fRadioLast := Result.fMenu; - if AParent.fRadio1st = 0 then + AParent.PropInt[ @RADIO_LAST ] := Result.fMenu; + if AParent.PropInt[ @RADIO_1ST ] = 0 then begin - AParent.fRadio1st := Result.fMenu; + AParent.PropInt[ @RADIO_1ST ] := Result.fMenu; Result.SetRadioChecked; end; end; {$IFDEF GRAPHCTL_XPSTYLES} - Result.fClassicTransparent := Result.fTransparent; - Attach_WM_THEMECHANGED(Result); - XP_Themes_For_RadioBox(Result); + Attach_WM_THEMECHANGED(Result, XP_Themes_For_RadioBox); {$ENDIF} end; {$ENDIF ASM_VERSION} -//[END NewRadiobox] {$ENDIF USE_CONSTRUCTORS} @@ -31797,29 +31780,42 @@ end; {$IFNDEF USE_CONSTRUCTORS} {$ENDIF not USE_CONSTRUCTORS} {$IFDEF USE_CONSTRUCTORS} -//[function NewLabel] function NewLabel( AParent: PControl; const Caption: AnsiString ): PControl; begin new( Result, CreateLabel( AParent, Caption ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Label'; + {$ENDIF} end; -//[END NewLabel] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewLabel] {$IFDEF GDI} {$IFDEF ASM_UNICODE} const StaticClass: Array[0..6] of AnsiChar=('S','T','A','T','I','C',#0); +{$ENDIF} +{$IFDEF ASM_UNICODE} function NewLabel( AParent: PControl; const Caption: KOLString ): PControl; asm PUSH EDX PUSH 0 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [LabelActions_Packed] + {$ELSE} PUSH offset[LabelActions] + {$ENDIF} MOV ECX, WS_VISIBLE or WS_CHILD or SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY MOV EDX, offset[StaticClass] CALL _NewControl + //INC byte ptr [EAX].TControl.aAutoSzX + //INC byte ptr [EAX].TControl.aAutoSzY + MOV word ptr [EAX].TControl.aAutoSzX, $101 + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG1, (1 shl G1_SizeRedraw) or (1 shl G1_IsStaticControl) + {$ELSE} INC [EAX].TControl.fIsStaticControl INC [EAX].TControl.fSizeRedraw + {$ENDIF} MOV EDX, [EAX].TControl.fBoundsRect.Top ADD EDX, 22 MOV [EAX].TControl.fBoundsRect.Bottom, EDX @@ -31827,24 +31823,12 @@ asm PUSH EAX CALL TControl.SetCaption POP EAX - + {$IFDEF GRAPHCTL_XPSTYLES} - PUSH EDX - MOV DL, [EAX].TControl.fTransparent - MOV [EAX].TControl.fClassicTransparent, DL - POP EDX - - PUSH EDX PUSH EAX + MOV EDX, offset[XP_Themes_For_Label] CALL Attach_WM_THEMECHANGED POP EAX - POP EDX - - PUSH EDX - PUSH EAX - CALL XP_Themes_For_Label - POP EAX - POP EDX {$ENDIF} end; {$ELSE ASM_VERSION} //Pascal @@ -31852,16 +31836,23 @@ function NewLabel( AParent: PControl; const Caption: KOLString ): PControl; begin Result := _NewControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY, - False ,@LabelActions ); - Inc( Result.fIsStaticControl ); - Result.fSizeRedraw := True; + False, {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed + {$ELSE} @LabelActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Label'; + {$ENDIF} + Result.aAutoSzX := 1; + Result.aAutoSzY := 1; + {$IFDEF USE_FLAGS} + Result.fFlagsG1 := Result.fFlagsG1 + [G1_SizeRedraw, G1_IsStaticControl]; + {$ELSE} Result.fSizeRedraw := True; + Inc( Result.fIsStaticControl ); + {$ENDIF} with Result.fBoundsRect do - Bottom := Top + 22; //Right := Left + 64 {done in _NewControl}; + Bottom := Top + 22; //Right := Left + 64 {done in _NewControl}; Result.Caption := Caption; {$IFDEF GRAPHCTL_XPSTYLES} - Result.fClassicTransparent := Result.fTransparent; - Attach_WM_THEMECHANGED(Result); - XP_Themes_For_Label(Result); + Attach_WM_THEMECHANGED(Result, XP_Themes_For_Label); {$ENDIF} end; {$ENDIF ASM_VERSION} @@ -31869,57 +31860,56 @@ end; {$IFDEF _X_} {$IFDEF GTK} -procedure LabelSetTextAlign( Self_: PControl ); -begin +PROCEDURE LabelSetTextAlign( Self_: PControl ); +BEGIN gtk_misc_set_alignment( GTK_MISC( Self_.fCaptionHandle ), HorAlignments[ Self_.fTextAlign ], VerAlignments[ Self_.fVerticalAlign ] ); -end; +END; -function NewLabel( AParent: PControl; const Caption: KOLString ): PControl; -begin +FUNCTION NewLabel( AParent: PControl; const Caption: KOLString ): PControl; +BEGIN Result := _NewControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY, False, gtk_label_new( PAnsiChar( String( Caption ) ) ), TRUE ); Result.fGetCaption := getLabelCaption; Result.fSetCaption := setLabelCaption; - Inc( Result.fIsStaticControl ); + {$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_IsStaticControl ); + {$ELSE} Inc( Result.fIsStaticControl ); {$ENDIF} Result.fSetTextAlign := LabelSetTextAlign; Result.fTextAlign := taCenter; Result.TextAlign := taLeft; -end; +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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:WordWrapLabel'; + {$ENDIF} end; -//[END NewWordWrapLabel] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewWordWrapLabel] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewWordWrapLabel( AParent: PControl; const Caption: KOLString ): PControl; begin Result := NewLabel( AParent, Caption ); - Result.fWordWrap := TRUE; + {$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_WordWrap ); + {$ELSE} Result.fWordWrap := TRUE; {$ENDIF} with Result.fBoundsRect do begin - Bottom := Top + 44; + Bottom := Top + 44; end; - Result.fStyle := Result.fStyle and not SS_LEFTNOWORDWRAP; + Result.fStyle.Value := Result.fStyle.Value and not SS_LEFTNOWORDWRAP; end; {$ENDIF ASM_VERSION} -//[END NewWordWrapLabel] {$ENDIF USE_CONSTRUCTORS} @@ -31929,45 +31919,48 @@ end; function NewLabelEffect( AParent: PControl; const Caption: AnsiString; ShadowDeep: Integer ): PControl; begin new( Result, CreateLabelEffect( AParent, Caption, ShadowDeep ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:LabelEffect'; + {$ENDIF} end; {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewLabelEffect] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewLabelEffect( AParent: PControl; const Caption: KOLString; ShadowDeep: Integer ): PControl; begin Result := NewLabel( AParent, '' ); - Dec( Result.fIsStaticControl ); // снова 0 ! + {$IFDEF USE_FLAGS} exclude( Result.fFlagsG1, G1_IsStaticControl ); + {$ELSE} Dec( Result.fIsStaticControl ); { снова 0 ! } {$ENDIF} Result.AttachProc( WndProcLabelEffect ); Result.Caption := Caption; Result.AttachProc( WndProcDoEraseBkgnd ); Result.fTextAlign := taCenter; Result.fTextColor := clWindowText; - Result.fShadowDeep := ShadowDeep; - Result.fIgnoreWndCaption := True; + Result.DF.fShadowDeep := ShadowDeep; + {$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_IgnoreWndCaption ); + {$ELSE} Result.fIgnoreWndCaption := True; {$ENDIF} with Result.fBoundsRect do begin Bottom := Top + 40; end; - Result.fColor2 := clNone; + Result.DF.fColor2 := clNone; 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Paintbox'; + {$ENDIF} end; {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewPaintbox] {$IFDEF GDI} {$UNDEF ASM_LOCAL} @@ -31990,15 +31983,25 @@ begin {$IFDEF GRAPHCTL_XPSTYLES} Result := _NewControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD {or SS_LEFTNOWORDWRAP or SS_NOPREFIX }or SS_NOTIFY, - False , @LabelActions ); - //Inc( Result.fIsStaticControl ); - Result.fSizeRedraw := True; - //with Result.fBoundsRect do - // Bottom := Top + 64; //Right := Left + 64 {done in _NewControl}; - Result.fClassicTransparent := Result.fTransparent; + False, {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed + {$ELSE} @LabelActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:PaintBox'; + {$ENDIF} + {$IFDEF USE_FLAGS} + include( Result.fFlagsG1, G1_SizeRedraw ); + if G2_Transparent in Result.fFlagsG2 then + include( Result.fFlagsG2, G2_ClassicTransparent ) + else exclude( Result.fFlagsG2, G2_ClassicTransparent ); + {$ELSE} Result.fSizeRedraw := True; + Result.fClassicTransparent := Result.fTransparent; + {$ENDIF} Result.fControlClassName := 'obj_PAINT'; {$ELSE} Result := NewLabel( AParent, '' ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Paintbox'; + {$ENDIF} with Result.fBoundsRect do begin Bottom := Top + 64; //Right := Left + 64 {done in NewLabel}; @@ -32007,29 +32010,26 @@ begin end; {$ENDIF ASM_VERSION} {$ENDIF GDI} + {$IFDEF _X_} {$IFDEF GTK} -function NewPaintbox( AParent: PControl ): PControl; -begin +FUNCTION NewPaintbox( AParent: PControl ): PControl; +BEGIN Result := NewLabel( AParent, '' ); Result.Height := 64; -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[END NewPaintbox] {$ENDIF USE_CONSTRUCTORS} {$IFDEF WIN_GDI} {$IFDEF _D2} -//[API SetBrushOrgEx] function SetBrushOrgEx(DC: HDC; X, Y: Integer; PrevPt: PPoint): BOOL; stdcall; external gdi32 name 'SetBrushOrgEx'; {$ENDIF} -//[FUNCTION WndProcDoEraseBkgnd] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION PAS_VERSION} +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION PAS_VERSION} function WndProcDoEraseBkgnd( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var DC: HDC; R: TRect; @@ -32049,9 +32049,7 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END WndProcDoEraseBkgnd] -//[function WndProcImageShow] function WndProcImageShow( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var PaintStruct: TPaintStruct; @@ -32080,7 +32078,6 @@ begin end; end; -//[function NewImageShow] function NewImageShow( AParent: PControl; AImgList: PImageList; ImgIdx: Integer ): PControl; var W, H: Integer; @@ -32101,14 +32098,12 @@ begin Bottom := Top + H; end; end; -//[END NewImageShow] //===================== Scrollbar ========================// const KSB_INITIALIZE = WM_USER + 10000; KSB_KEY = $3232; -//[function WndProcScrollBarParent] function WndProcScrollBarParent( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Bar: PControl; @@ -32167,47 +32162,44 @@ begin NewPos := SI.nMin; AllowChange := True; - if Assigned(Bar.OnSBBeforeScroll) then - Bar.OnSBBeforeScroll(Bar, SI.nPos, NewPos, Cmd, AllowChange); - if AllowChange then - SI.nPos := NewPos + {$IFDEF NIL_EVENTS} + if Assigned(Bar.EV.fOnSBBeforeScroll) then + {$ENDIF} + Bar.EV.fOnSBBeforeScroll(Bar, SI.nPos, NewPos, Cmd, AllowChange); + if AllowChange then + SI.nPos := NewPos else - SI.nTrackPos := SI.nPos; - Bar.fSBPosition := SI.nPos; - Bar.fSBPosition := Bar.SBSetScrollInfo(SI); - if AllowChange and Assigned(Bar.OnSBScroll) then - Bar.OnSBScroll(Bar, Cmd); + SI.nTrackPos := SI.nPos; + Bar.DF.fSBPosition := SI.nPos; + Bar.DF.fSBPosition := Bar.SBSetScrollInfo(SI); + if AllowChange + {$IFDEF NIL_EVENTS} and Assigned(Bar.EV.fOnSBScroll) {$ENDIF} then + Bar.EV.fOnSBScroll(Bar, Cmd); end; end; end; end; -//[END WndProcScrollBarParent] -//[function NewScrollBar] function NewScrollBar( AParent: PControl; BarSide: TScrollerBar ): PControl; const SBS_Directions: array[ TScrollerBar ] of DWORD = ( SBS_HORZ or SBS_BOTTOMALIGN, SBS_VERT or SBS_RIGHTALIGN ); begin - Result := _NewCommonControl( - AParent, - 'SCROLLBAR', + Result := _NewCommonControl( AParent, 'SCROLLBAR', WS_VISIBLE or WS_CHILD or SBS_Directions[ BarSide ], - False, - nil - ); -{!ecm} - Result.GetWindowHandle; -{/!ecm} - Result.DetachProc(WndProcCtrl); - Result.fLookTabKeys := [tkTab]; + False, {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS ) + {$ELSE} nil {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:ScrollBar'; + {$ENDIF} + {!ecm} Result.GetWindowHandle; {/!ecm} + Result.DetachProc(WndProcCtrl); + Result.fLookTabKeys := [tkTab]; -//#ecm Result.AttachProc(WndProcScrollBar); - AParent.AttachProc(WndProcScrollBarParent); + //#ecm Result.AttachProc(WndProcScrollBar); + AParent.AttachProc(WndProcScrollBarParent); end; -//[END NewScrollBar] //===================== Scrollbox ========================// -//[function WndProcScrollBox] function WndProcScrollBox( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Bar: DWORD; SI: TScrollInfo; @@ -32218,8 +32210,10 @@ begin WM_HSCROLL: Bar := SB_HORZ; WM_VSCROLL: Bar := SB_VERT; WM_SIZE: begin - if Assigned( Sender.fNotifyChild ) then - Sender.fNotifyChild( Sender, nil ); + {$IFDEF NIL_EVENTS} + if Assigned( Sender.PP.fNotifyChild ) then + {$ENDIF} + Sender.PP.fNotifyChild( Sender, nil ); Result := FALSE; Exit; end; @@ -32237,8 +32231,8 @@ begin case LoWord( Msg.wParam ) of SB_BOTTOM: SI.nPos := SI.nMax; SB_TOP: SI.nPos := SI.nMin; - SB_LINEDOWN: Inc( SI.nPos, Sender.FScrollLineDist[ Bar ] ); - SB_LINEUP: Dec( SI.nPos, Sender.FScrollLineDist[ Bar ] ); + SB_LINEDOWN: Inc( SI.nPos, Sender.DF.fScrollLineDist[ Bar ] ); + SB_LINEUP: Dec( SI.nPos, Sender.DF.fScrollLineDist[ Bar ] ); SB_PAGEDOWN: Inc( SI.nPos, Max( SI.nPage, 1 ) ); SB_PAGEUP: Dec( SI.nPos, Max( SI.nPage, 1 ) ); SB_THUMBTRACK:SI.nPos := SI.nTrackPos; @@ -32249,20 +32243,20 @@ begin SI.nPos := SI.nMin; SetScrollInfo( Sender.fHandle, Bar, SI, TRUE ); - if Assigned( Sender.fScrollChildren ) then + {$IFDEF NIL_EVENTS} + if Assigned( Sender.PP.fScrollChildren ) then + {$ENDIF} begin - OldNotifyProc := @ Sender.fNotifyChild; - Sender.fNotifyChild := nil; - Sender.fScrollChildren( Sender ); - Sender.fNotifyChild := OldNotifyProc; + OldNotifyProc := @ Sender.PP.fNotifyChild; + Sender.PP.fNotifyChild := @DummyObjProc; + Sender.PP.fScrollChildren( Sender ); + Sender.PP.fNotifyChild := OldNotifyProc; end; SetScrollInfo( Sender.fHandle, Bar, SI, TRUE ); Result := FALSE; end; -//[END WndProcScrollBox] -//[function NewScrollBox] function NewScrollBox( AParent: PControl; EdgeStyle: TEdgeStyle; Bars: TScrollerBars ): PControl; var SBFlag: Integer; @@ -32274,13 +32268,18 @@ begin SBFlag := SBFlag or WS_VSCROLL; Result := _NewControl( AParent, 'ScrollBox', WS_VISIBLE or WS_CHILD or - SBFlag, EdgeStyle = esLowered, nil ); + SBFlag, EdgeStyle = esLowered, + {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS ) + {$ELSE} nil {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:ScrollBox'; + {$ENDIF} Result.AttachProc( WndProcForm ); //!!! Result.AttachProc( WndProcScrollBox ); Result.AttachProc( WndProcDoEraseBkgnd ); - Result.fIsControl := TRUE; + {$IFDEF USE_FLAGS} include( Result.fFlagsG3, G3_IsControl ); + {$ELSE} Result.fIsControl := TRUE; {$ENDIF} end; -//[END NewScrollBox] function Scrollbar_GetMinPos( sb: PControl ): Integer; begin @@ -32330,17 +32329,17 @@ begin Result := 1; end; - -//[function WndProcNotifyParentAboutResize] function WndProcNotifyParentAboutResize( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var P: PControl; begin if (Msg.message = WM_SIZE) or (Msg.message = WM_MOVE) or (Msg.message = CM_SHOW) then begin P := Sender.Parent; - if P <> nil then - if Assigned( P.fNotifyChild ) then - P.fNotifyChild( P, nil ); + if P <> nil then + {$IFDEF NIL_EVENTS} + if Assigned( P.PP.fNotifyChild ) then + {$ENDIF} + P.PP.fNotifyChild( P, nil ); end else if Msg.message = WM_SHOWWINDOW then @@ -32348,7 +32347,6 @@ begin Result := FALSE; end; -//[procedure CalcMinMaxChildren] procedure CalcMinMaxChildren( Self_: PControl; var SzR: TRect ); var I: Integer; C: PControl; @@ -32395,7 +32393,6 @@ begin Inc( SzR.Bottom, Self_.Border - 1 ); end; -//[procedure NotifyScrollBox] procedure NotifyScrollBox( Self_, Child: PControl ); var SI: TScrollInfo; @@ -32441,10 +32438,10 @@ var W, H: Integer; SzR: TRect; R: TRect; begin - if Assigned( Child ) then + if ( Child <> nil ) then begin - Child.AttachProc( WndProcNotifyParentAboutResize ); - Exit; + Child.AttachProc( WndProcNotifyParentAboutResize ); + Exit; end; CalcMinMaxChildren( Self_, SzR ); W := SzR.Right - SzR.Left; @@ -32461,10 +32458,12 @@ begin GetSetScrollInfo( SB_HORZ, W, R.Right, SzR.Left, SzR.Right ); {+ecm}R := Self_.ClientRect;{/+ecm} GetSetScrollInfo( SB_VERT, H, R.Bottom, SzR.Top, SzR.Bottom ); -{+ecm} if Assigned( Self_.fScrollChildren ) then Self_.fScrollChildren(Self_); {/+ecm} +{+ecm} {$IFDEF NIL_EVENTS} + if Assigned( Self_.PP.fScrollChildren ) then + {$ENDIF} + Self_.PP.fScrollChildren(Self_); {/+ecm} end; -//[procedure ScrollChildren] procedure ScrollChildren( _Self_: PControl ); var SzR, R: TRect; I, Xpos, Ypos: Integer; @@ -32484,8 +32483,8 @@ begin if (DeltaX <> 0) or (DeltaY <> 0) then begin - OldNotifyProc := @ _Self_.fNotifyChild; - _Self_.fNotifyChild := nil; + OldNotifyProc := @ _Self_.PP.fNotifyChild; + _Self_.PP.fNotifyChild := @DummyObjProc; for I := 0 to _Self_.fChildren.fCount - 1 do begin @@ -32495,74 +32494,81 @@ begin C.BoundsRect := R; end; - _Self_.fNotifyChild := OldNotifyProc; + _Self_.PP.fNotifyChild := OldNotifyProc; CalcMinMaxChildren( _Self_, R ); if //(SzR.Left <> R.Left) or (SzR.Top <> R.Top) or //(Szr.Right <> R.Right) or (SzR.Bottom <> R.Bottom) ((SzR.Right - SzR.Left) <> (R.Right - R.Left)) or ((SzR.Bottom - SzR.Top) <> (R.Bottom - R.Top)) then - if Assigned( _Self_.fNotifyChild ) then - _Self_.fNotifyChild( _Self_, nil ); + {$IFDEF NIL_EVENTS} + if Assigned( _Self_.PP.fNotifyChild ) then + {$ENDIF} + _Self_.PP.fNotifyChild( _Self_, nil ); end; end; -//[function NewScrollBoxEx] function NewScrollBoxEx( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl; begin Result := NewScrollBox( AParent, EdgeStyle, [ ] ); - Result.fNotifyChild := NotifyScrollBox; - Result.fScrollChildren := ScrollChildren; - Result.FScrollLineDist[ 0 ] := 16; - Result.FScrollLineDist[ 1 ] := 16; + Result.PP.fNotifyChild := NotifyScrollBox; + Result.PP.fScrollChildren := ScrollChildren; + Result.DF.fScrollLineDist[ 0 ] := 16; + Result.DF.fScrollLineDist[ 1 ] := 16; end; -//[function WndProcOnScroll] function WndProcOnScroll( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Bar: TScrollerBar; begin Bar := sbHorizontal; //0 - if Msg.message = WM_VSCROLL then - Bar := sbVertical + if Msg.message = WM_VSCROLL then + Bar := sbVertical else - if Msg.message <> WM_HSCROLL then + if Msg.message <> WM_HSCROLL then begin - Result := FALSE; - Exit; + Result := FALSE; + Exit; end; - if Assigned( Sender.OnScroll ) then - Sender.OnScroll( Sender, Bar, LoWord( Msg.wParam ), HiWord( Msg.wParam ) ); + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnScroll ) then + {$ENDIF} + Sender.EV.fOnScroll( Sender, Bar, LoWord( Msg.wParam ), + HiWord( Msg.wParam ) ); Result := FALSE; end; -//[procedure TControl.SetOnScroll] procedure TControl.SetOnScroll(const Value: TOnScroll); begin - FOnScroll := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .FOnScroll := Value; AttachProc( @ WndProcOnScroll ); end; //===================== Groupbox ========================// {$IFDEF USE_CONSTRUCTORS} -//[function NewGroupbox] function NewGroupbox( AParent: PControl; const Caption: AnsiString ): PControl; begin new( Result, CreateGroupbox( AParent, Caption ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Groupbox'; + {$ENDIF} end; -//[END NewGroupbox] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewGroupbox] {$IFDEF ASM_UNICODE} function NewGroupbox( AParent: PControl; const Caption: KOLString ): PControl; asm PUSH EDX PUSH 0 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [ButtonActions_Packed] + {$ELSE} PUSH offset[ButtonActions] + {$ENDIF} MOV EDX, offset[ButtonClass] MOV ECX, WS_VISIBLE or WS_CHILD or BS_GROUPBOX or WS_CLIPCHILDREN or WS_CLIPSIBLINGS CALL _NewControl @@ -32573,40 +32579,36 @@ asm MOV EDX, [EAX].TControl.fBoundsRect.Top ADD EDX, 100 MOV [EAX].TControl.fBoundsRect.Bottom, EDX - MOV [EAX].TControl.fClientTop, 22 + MOV byte ptr [EAX].TControl.fClientTop, 22 XOR EDX, EDX + {$IFDEF USE_FLAGS} + AND [EAX].TControl.fStyle.f2_Style, not(1 shl F2_Tabstop) + {$ELSE} MOV [EAX].TControl.fTabstop, DL + {$ENDIF USE_FLAGS} MOV DL, 2 - ADD [EAX].TControl.fClientBottom, EDX - ADD [EAX].TControl.fClientLeft, EDX - ADD [EAX].TControl.fClientRight, EDX + ADD [EAX].TControl.fClientBottom, DL + ADD [EAX].TControl.fClientLeft, DL + ADD [EAX].TControl.fClientRight, DL POP EDX PUSH EAX CALL TControl.SetCaption POP EAX PUSH EAX + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG5, 1 shl G5_IsGroupbox + {$ELSE} INC [EAX].TControl.fIsGroupBox + {$ENDIF} MOV EDX, offset[WndProcDoEraseBkgnd] CALL TControl.AttachProc POP EAX {$IFDEF GRAPHCTL_XPSTYLES} - PUSH EDX - MOV DL, [EAX].TControl.fTransparent - MOV [EAX].TControl.fClassicTransparent, DL - POP EDX - - PUSH EDX PUSH EAX + MOV EDX, offset[XP_Themes_For_GroupBox] CALL Attach_WM_THEMECHANGED POP EAX - POP EDX - - PUSH EDX - PUSH EAX - CALL XP_Themes_For_GroupBox - POP EAX - POP EDX {$ENDIF} end; {$ELSE ASM_VERSION} //Pascal @@ -32618,7 +32620,11 @@ begin or WS_CLIPCHILDREN or WS_VISIBLE or BS_GROUPBOX, - FALSE, @ButtonActions ); + FALSE, {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed + {$ELSE} @ButtonActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Groupbox'; + {$ENDIF} Result.fExStyle := Result.fExStyle or WS_EX_CONTROLPARENT; Result.Caption := Caption; with Result.fBoundsRect do @@ -32630,34 +32636,33 @@ begin Result.fClientBottom := 2; Result.fClientLeft := 2; Result.fClientRight := 2; - Result.fTabstop := False; - Result.fIsGroupBox := TRUE; + {$IFDEF USE_FLAGS} + exclude( Result.fStyle.f2_Style, F2_Tabstop ); + include( Result.fFlagsG5, G5_IsGroupbox ); + {$ELSE} Result.fTabstop := False; + Result.fIsGroupBox := TRUE; + {$ENDIF} Result.AttachProc( WndProcDoEraseBkgnd ); {$IFDEF GRAPHCTL_XPSTYLES} - Result.fClassicTransparent := Result.fTransparent; - //if AppTheming then - // Result.Style := Result.Style or BS_OWNERDRAW; - Attach_WM_THEMECHANGED(Result); - XP_Themes_For_GroupBox(Result); + Attach_WM_THEMECHANGED(Result, XP_Themes_For_GroupBox); {$ENDIF} 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Panel'; + {$ENDIF} end; -//[END NewPanel] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewPanel] {$IFDEF ASM_UNICODE} function NewPanel( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl; const CreateStyle = WS_VISIBLE or WS_CHILD or SS_LEFTNOWORDWRAP or @@ -32672,8 +32677,15 @@ asm MOV EDX, offset[StaticClass] MOV ECX, CreateStyle PUSH 0 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [LabelActions_Packed] + {$ELSE} PUSH offset[LabelActions] + {$ENDIF} CALL _NewControl + //INC byte ptr [EAX].TControl.aAutoSzX + //INC byte ptr [EAX].TControl.aAutoSzY + MOV word ptr [EAX].TControl.aAutoSzX, $101 ADD [EAX].TControl.fBoundsRect.Right, 100-64 ADD [EAX].TControl.fBoundsRect.Bottom, 100-64 OR byte ptr [EAX].TControl.fExStyle+2, 1 @@ -32703,56 +32715,44 @@ asm @@not_sunken: AND byte ptr [EAX].TControl.fStyle+1, $00 @@es_none_: - - PUSH EBX - MOV BL, [EAX].TControl.fTransparent - MOV [EAX].TControl.fClassicTransparent, BL - POP EBX - POP EDX PUSH EAX - PUSH EDX CALL TControl.SetEdgeStyle - POP EDX POP EAX - - PUSH EDX PUSH EAX + MOV EDX, offset[XP_Themes_For_Panel] CALL Attach_WM_THEMECHANGED POP EAX - POP EDX - - PUSH EDX - PUSH EAX - CALL XP_Themes_For_Panel - POP EAX - POP EDX {$ENDIF} end; {$ELSE ASM_VERSION} //Pascal function NewPanel( AParent: PControl; EdgeStyle: TEdgeStyle ): PControl; begin Result := _NewControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or SS_NOTIFY or - SS_LEFTNOWORDWRAP or SS_NOPREFIX, False, @LabelActions ); + SS_LEFTNOWORDWRAP or SS_NOPREFIX, False, + {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed + {$ELSE} @LabelActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Panel'; + {$ENDIF} + Result.aAutoSzX := 1; + Result.aAutoSzY := 1; with Result.fBoundsRect do begin Right := Left + 100; Bottom := Top + 100; end; - Result.fStyle := Result.fStyle or Edgestyles[ EdgeStyle ]; + Result.fStyle.Value := Result.fStyle.Value or Edgestyles[ EdgeStyle ]; Result.fExStyle := Result.fExStyle or WS_EX_CONTROLPARENT; Result.fVerticalAlign := vaTop; {$IFDEF GRAPHCTL_XPSTYLES} - Result.fClassicTransparent := Result.fTransparent; if AppTheming then - Result.fStyle := Result.fStyle and (not Edgestyles[ EdgeStyle ]); + Result.fStyle.Value := Result.fStyle.Value and (not Edgestyles[ EdgeStyle ]); Result.SetEdgeStyle(EdgeStyle); - Attach_WM_THEMECHANGED(Result); - XP_Themes_For_Panel(Result); + Attach_WM_THEMECHANGED(Result, XP_Themes_For_Panel); {$ENDIF} end; {$ENDIF ASM_VERSION} -//[END NewPanel] {$ENDIF USE_CONSTRUCTORS} @@ -32767,7 +32767,6 @@ end; {$DEFINE USE_PAS_DODRAG} {$ENDIF} {$IFDEF USE_PAS_DODRAG} -//[procedure DoDrag] procedure DoDrag( Self_: PControl; Cancel: Boolean ); var NewSize1, NewSize2: Integer; MousePos: TPoint; @@ -32775,66 +32774,70 @@ var NewSize1, NewSize2: Integer; Prev: PControl; I, M : Integer; begin - if Self_.fDragging then + if {$IFDEF USE_FLAGS} G6_Dragging in Self_.fFlagsG6 + {$ELSE} Self_.fDragging {$ENDIF} then begin - I := Self_.fParent.fChildren.IndexOf( Self_ ); - Prev := Self_; - if I > 0 then - Prev := Self_.FParent.fChildren.Items[ I - 1 ]; - GetCursorPos( MousePos ); - if Cancel then - MousePos := Self_.fSplitStartPos; - M := 1; - if Self_.FAlign in [ caRight, caBottom ] then - M := -1; - if Self_.FAlign in [ caTop, caBottom ] then - begin - NewSize1 := (MousePos.y - Self_.fSplitStartPos.y)* M - + Self_.fSplitStartSize; - NewSize2 := Self_.fParent.ClientHeight - NewSize1 - - Self_.fBoundsRect.Bottom + Self_.fBoundsRect.Top - - Self_.fParent.fMargin * 4; - if Self_.fSecondControl <> nil then + I := Self_.fParent.fChildren.IndexOf( Self_ ); + Prev := Self_; + if I > 0 then + Prev := Self_.FParent.fChildren.Items[ I - 1 ]; + GetCursorPos( MousePos ); + if Cancel then + MousePos := Self_.DF.fSplitStartPos; + M := 1; + if Self_.FAlign in [ caRight, caBottom ] then + M := -1; + if Self_.FAlign in [ caTop, caBottom ] then begin - NewSize2 := Self_.fSecondControl.fBoundsRect.Bottom - - Self_.fSecondControl.fBoundsRect.Top; - if Self_.fSecondControl.FAlign = caClient then - NewSize2 := Self_.fSplitStartPos2.y - - (MousePos.y - Self_.fSplitStartPos.y)* M - - Self_.fParent.fMargin * 4; - end; + NewSize1 := (MousePos.y - Self_.DF.fSplitStartPos.y)* M + + Self_.DF.fSplitStartSize; + NewSize2 := Self_.fParent.ClientHeight - NewSize1 + - Self_.fBoundsRect.Bottom + Self_.fBoundsRect.Top + - Self_.fParent.fMargin * 4; + if Self_.DF.fSecondControl <> nil then + begin + NewSize2 := Self_.DF.fSecondControl.fBoundsRect.Bottom + - Self_.DF.fSecondControl.fBoundsRect.Top; + if Self_.DF.fSecondControl.FAlign = caClient then + NewSize2 := Self_.DF.fSplitStartPos2.y + - (MousePos.y - Self_.DF.fSplitStartPos.y)* M + - Self_.fParent.fMargin * 4; + end; end else begin - NewSize1 := (MousePos.x - Self_.fSplitStartPos.x)* M - + Self_.fSplitStartSize; - NewSize2 := Self_.fParent.ClientWidth - NewSize1 - - Self_.fBoundsRect.Right + Self_.fBoundsRect.Left - - Self_.fParent.fMargin * 4; - if Self_.fSecondControl <> nil then - begin - NewSize2 := Self_.fSecondControl.fBoundsRect.Right - - Self_.fSecondControl.fBoundsRect.Left; - if Self_.fSecondControl.FAlign = caClient then - NewSize2 := Self_.fSplitStartPos2.x - - (MousePos.x - Self_.fSplitStartPos.x)* M - - Self_.fParent.Margin * 4; - end; + NewSize1 := (MousePos.x - Self_.DF.fSplitStartPos.x)* M + + Self_.DF.fSplitStartSize; + NewSize2 := Self_.fParent.ClientWidth - NewSize1 + - Self_.fBoundsRect.Right + Self_.fBoundsRect.Left + - Self_.fParent.fMargin * 4; + if Self_.DF.fSecondControl <> nil then + begin + NewSize2 := Self_.DF.fSecondControl.fBoundsRect.Right + - Self_.DF.fSecondControl.fBoundsRect.Left; + if Self_.DF.fSecondControl.FAlign = caClient then + NewSize2 := Self_.DF.fSplitStartPos2.x + - (MousePos.x - Self_.DF.fSplitStartPos.x)* M + - Self_.fParent.Margin * 4; + end; end; - if (NewSize1 < Self_.fSplitMinSize1) then + if (NewSize1 < Self_.DF.fSplitMinSize1) then begin - Dec( NewSize2, Self_.fSplitMinSize1 - NewSize1 ); - NewSize1 := Self_.fSplitMinSize1; + Dec( NewSize2, Self_.DF.fSplitMinSize1 - NewSize1 ); + NewSize1 := Self_.DF.fSplitMinSize1; end; - if (NewSize2 < Self_.fSplitMinSize2) then + if (NewSize2 < Self_.DF.fSplitMinSize2) then begin - Dec( NewSize1, Self_.fSplitMinSize2 - NewSize2 ); - NewSize2 := Self_.fSplitMinSize2; + Dec( NewSize1, Self_.DF.fSplitMinSize2 - NewSize2 ); + NewSize2 := Self_.DF.fSplitMinSize2; end; - if NewSize1 < Self_.fSplitMinSize1 then Exit; - if NewSize2 < Self_.fSplitMinSize2 then Exit; - if assigned( Self_.fOnSplit ) then - if not Self_.fOnSplit( Self_, NewSize1, NewSize2 ) then Exit; + if NewSize1 < Self_.DF.fSplitMinSize1 then Exit; + if NewSize2 < Self_.DF.fSplitMinSize2 then Exit; + {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnSplit ) then + {$ENDIF} + if not Self_.EV.fOnSplit( Self_, NewSize1, NewSize2 ) then + Exit; R := Prev.BoundsRect; case Self_.FAlign of caTop: R.Bottom := R.Top + NewSize1; @@ -32860,9 +32863,7 @@ const {$DEFINE USE!_ASM_DODRAG} -//[FUNCTION WndProcSplitter] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProcSplitter( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var I: Integer; Prev: PControl; @@ -32870,7 +32871,8 @@ var I: Integer; procedure FinDrag; begin KillTimer( Self_.fHandle, $7B ); - Self_.fDragging := False; + {$IFDEF USE_FLAGS} exclude( Self_.fFlagsG6, G6_Dragging ); + {$ELSE} Self_.fDragging := False; {$ENDIF} ReleaseCapture; end; begin @@ -32897,16 +32899,17 @@ begin if I > 0 then Prev := Self_.FParent.fChildren.Items[ I - 1 ]; if Self_.fAlign in [ caTop, caBottom ] then - Self_.fSplitStartSize := Prev.Height + Self_.DF.fSplitStartSize := Prev.Height else - Self_.fSplitStartSize := Prev.Width; - if Self_.fSecondControl <> nil then - Self_.fSplitStartPos2 := - MakePoint( Self_.fSecondControl.Width, Self_.fSecondControl.Height ); + Self_.DF.fSplitStartSize := Prev.Width; + if Self_.DF.fSecondControl <> nil then + Self_.DF.fSplitStartPos2 := + MakePoint( Self_.DF.fSecondControl.Width, Self_.DF.fSecondControl.Height ); SetCapture( Self_.fHandle ); - Self_.fDragging := True; + {$IFDEF USE_FLAGS} Include( Self_.fFlagsG6, G6_Dragging ); + {$ELSE} Self_.fDragging := True; {$ENDIF} SetTimer( Self_.fHandle, $7B, 100, nil ); - GetCursorPos( Self_.fSplitStartPos ); + GetCursorPos( Self_.DF.fSplitStartPos ); end; end; WM_LBUTTONUP: @@ -32915,7 +32918,9 @@ begin FinDrag; end; WM_TIMER: - if Self_.fDragging and (GetAsyncKeyState( VK_ESCAPE ) < 0) then + if {$IFDEF USE_FLAGS} (G6_Dragging in Self_.fFlagsG6) + {$ELSE} Self_.fDragging {$ENDIF} + and (GetAsyncKeyState( VK_ESCAPE ) < 0) then begin DoDrag( Self_, True ); FinDrag; @@ -32924,37 +32929,34 @@ begin Result := False; end; {$ENDIF ASM_VERSION} -//[END WndProcSplitter] -//[function NewSplitter] function NewSplitter( AParent: PControl; MinSizePrev, MinSizeNext: Integer ): PControl; begin Result := NewSplitterEx( AParent, MinSizePrev, MinSizeNext, esLowered ); 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:SplitterEx'; + {$ENDIF} end; -//[END NewSplitterEx] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewSplitterEx] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewSplitterEx( AParent: PControl; MinSizePrev, MinSizeNext: Integer; EdgeStyle: TEdgeStyle ): PControl; var PrevCtrl: PControl; Sz0: Integer; begin Result := NewPanel( AParent, EdgeStyle ); - Result.fSplitMinSize1 := MinSizePrev; - Result.fSplitMinSize2 := MinSizeNext; - Result.fIsSplitter := TRUE; + Result.DF.fSplitMinSize1 := MinSizePrev; + Result.DF.fSplitMinSize2 := MinSizeNext; + {$IFDEF USE_FLAGS} include( Result.fFlagsG5, G5_IsSplitter ); + {$ELSE} Result.fIsSplitter := TRUE; {$ENDIF} Sz0 := 4; with Result.fBoundsRect do begin @@ -32981,36 +32983,34 @@ begin end; Result.AttachProc( WndProcSplitter ); {$IFDEF GRAPHCTL_XPSTYLES} - Result.fClassicTransparent := Result.fTransparent; - Attach_WM_THEMECHANGED(Result); - XP_Themes_For_Splitter(Result); + Attach_WM_THEMECHANGED(Result, XP_Themes_For_Splitter); {$ENDIF} end; {$ENDIF ASM_VERSION} -//[END NewSplitterEx] {$ENDIF USE_CONSTRUCTORS} //===================== MDI client window control =============// -//[procedure DestroyMDIChildren] procedure DestroyMDIChildren( Form: PControl ); var MDIClient: PControl; I: Integer; Ch: PControl; + MDIChildren: PList; begin - MDIClient := Form.fMDIClient; - MDIClient.fMDIDestroying := TRUE; - if MDIClient = nil then Exit; - if MDIClient.fMDIChildren <> nil then - for I := MDIClient.fMDIChildren.Count - 1 downto 0 do + MDIClient := Form.MDIClient; + MDIClient.fAnchors := MDIClient.fAnchors or MDI_DESTROYING; + if MDIClient = nil then Exit; + MDIChildren := Pointer( MDIClient.PropInt[ MDI_CHLDRN ] ); + if MDIChildren <> nil then + for I := MDIChildren.Count - 1 downto 0 do begin - Ch := MDIClient.fMDIChildren.Items[ I ]; - if Ch.fHandle <> 0 then - MDIClient.Perform( WM_MDIDESTROY, Ch.fHandle, 0 ); + Ch := MDIChildren.Items[ I ]; + if Ch.fHandle <> 0 then + MDIClient.Perform( WM_MDIDESTROY, Ch.fHandle, 0 ); end; - MDIClient.fMDIChildren.Free; - MDIClient.fMDIChildren := nil; + MDIChildren.Free; + MDIClient.PropInt[ MDI_CHLDRN ] := 0; if Form.fMenu <> 0 then begin MDIClient.Perform( WM_MDISETMENU, 0, 0 ); @@ -33019,11 +33019,10 @@ begin Form.fMenuObj.Free; Form.fMenuObj := nil; end; - Form.fMDIClient := nil; + Form.MDIClient := nil; MDIClient.Free; end; -//[function ProcMDIAccel] function ProcMDIAccel( Applet: PControl; var Msg: TMsg ): Boolean; var Form: PControl; begin @@ -33042,25 +33041,24 @@ begin end; end; -//[function CallDefFrameProc] function CallDefFrameProc( Wnd: HWnd; Msg: Integer; wParam, lParam: Integer ): Integer; stdcall; -var Form: PControl; +var Form, MDIClient: PControl; begin {$IFDEF USE_PROP} Form := Pointer( GetProp( Wnd, ID_SELF ) ); {$ELSE} Form := Pointer( GetWindowLong( Wnd, GWL_USERDATA ) ); {$ENDIF} - if Form <> nil then - Form := Form.ParentForm; - if (Form <> nil) and (Form.fMDIClient <> nil) then - Result := DefFrameProc( Wnd, Form.fMDIClient.fHandle, Msg, wParam, lParam ) + if Form <> nil then + Form := Form.ParentForm; + MDIClient := Form.MDIClient; + if (Form <> nil) and (MDIClient <> nil) then + Result := DefFrameProc( Wnd, MDIClient.fHandle, Msg, wParam, lParam ) else - Result := DefWindowProc( Wnd, Msg, wParam, lParam ); + Result := DefWindowProc( Wnd, Msg, wParam, lParam ); end; -//[function WndFuncMDIClient] function WndFuncMDIClient( Wnd: HWnd; Msg, wParam, lParam: Integer ): Integer; stdcall; var C: PControl; @@ -33083,43 +33081,42 @@ begin Result := DefWindowProc( Wnd, Msg, wParam, lParam ); end; -//[function ShowMDIClientEdge] function ShowMDIClientEdge( MDIClient: PControl ): Boolean; var ShowEdge: Boolean; I: Integer; Ch: PControl; ExStyle: Integer; + MDIChildren: PList; begin Result := FALSE; ShowEdge := TRUE; - if MDIClient.fMDIChildren.Count > 0 then - for I := 0 to MDIClient.fMDIChildren.Count-1 do - begin - Ch := MDIClient.fMDIChildren.Items[ I ]; - if IsZoomed( Ch.fHandle ) then + MDIChildren := Pointer( MDIClient.PropInt[ MDI_CHLDRN ] ); + if MDIChildren.Count > 0 then + for I := 0 to MDIChildren.Count-1 do begin - ShowEdge := FALSE; - break; + Ch := MDIChildren.Items[ I ]; + if IsZoomed( Ch.fHandle ) then + begin + ShowEdge := FALSE; + break; + end; end; - end; ExStyle := MDIClient.ExStyle; - if ShowEdge then - if ExStyle and WS_EX_CLIENTEDGE = 0 then - ExStyle := ExStyle or WS_EX_CLIENTEDGE - else - Exit + if ShowEdge then + if ExStyle and WS_EX_CLIENTEDGE = 0 then + ExStyle := ExStyle or WS_EX_CLIENTEDGE + else + Exit else if ExStyle and WS_EX_CLIENTEDGE <> 0 then - ExStyle := ExStyle and not WS_EX_CLIENTEDGE - else - Exit; + ExStyle := ExStyle and not WS_EX_CLIENTEDGE + else Exit; MDIClient.ExStyle := ExStyle; Result := TRUE; end; -//[function WndProcMDIClient] function WndProcMDIClient( MDIClient: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin - if not MDIClient.fMDIDestroying then + if not MDIClient.fAnchors and MDI_DESTROYING = 0 then case Msg.message of $3f: begin @@ -33156,7 +33153,6 @@ begin end; // function added by Thaddy de Koning to fix MDI behaviour -//[function WndProcParentNotifyMouseLDown] function WndProcParentNotifyMouseLDown( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin @@ -33166,7 +33162,6 @@ begin BringWindowToTop( Sender.Handle ); end; -//[function NewMDIClient] function NewMDIClient( AParent: PControl; WindowMenu: THandle ): PControl; var F: PControl; CCS: TClientCreateStruct; @@ -33185,11 +33180,16 @@ begin end; PrntWin := AParent.GetWindowHandle; end; - Applet.fExMsgProc := ProcMDIAccel; + Applet.PP.fExMsgProc := ProcMDIAccel; Result := _NewControl( AParent, 'MDICLIENT', WS_CHILD or WS_CLIPCHILDREN or WS_VSCROLL or WS_HSCROLL or - WS_VISIBLE or WS_TABSTOP or MDIS_ALLCHILDSTYLES, TRUE, nil ); - Result.fMDIChildren := NewList; + WS_VISIBLE or WS_TABSTOP or MDIS_ALLCHILDSTYLES, TRUE, + {$IFDEF PACK_COMMANDACTIONS} PAnsiChar(OTHER_ACTIONS) + {$ELSE} nil {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:MDIClient'; + {$ENDIF} + Result.PropInt[ MDI_CHLDRN ] := Integer( NewList ); Result.fExStyle := WS_EX_CLIENTEDGE; CCS.hWindowMenu := WindowMenu; @@ -33205,8 +33205,8 @@ begin {$ELSE} SetWindowLong( Result.fHandle, GWL_USERDATA, Integer( Result ) ); {$ENDIF} - if F <> nil then - F.fMDIClient := Result; + if F <> nil then + F.MDIClient := Result; Result.AttachProc( WndProcMDIClient ); Result.GetWindowHandle; @@ -33214,7 +33214,6 @@ begin end; //===================== MDI child window object ==============// -//[function MDIChildFunc] function MDIChildFunc( Wnd: HWnd; Msg: DWord; wParam, lParam: Integer ): Integer; stdcall; var C: PControl; @@ -33237,13 +33236,13 @@ begin Result := DefMDIChildProc( Wnd, Msg, wParam, lParam ); end; -//[function Pass2DefMDIChildProc] function Pass2DefMDIChildProc( Sender_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin Result := FALSE; if Sender_ = nil then Exit; if Sender_.Parent = nil then Exit; - if Sender_.Parent.fDestroying then Exit; + if {$IFDEF USE_FLAGS} G2_Destroying in Sender_.Parent.fFlagsG2 + {$ELSE} Sender_.Parent.fDestroying {$ENDIF} then Exit; if (Msg.message = WM_SYSCOMMAND) or (Msg.message = WM_CHILDACTIVATE) or (Msg.message = WM_SETFOCUS) or (Msg.message = WM_SIZE) or (Msg.message = WM_MOVE) or (Msg.message = WM_MENUCHAR) or @@ -33254,11 +33253,11 @@ begin end; end; -//[function WndProcMDIChild] function WndProcMDIChild( MDIChild: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var ClientWnd: HWnd; MDIClient: PControl; MDIForm: PControl; + MDIChildren: PList; begin Result := FALSE; MDIClient := MDIChild.Parent; @@ -33268,24 +33267,24 @@ begin case Msg.message of WM_DESTROY: begin - MDIClient.fMDIChildren.Remove( MDIChild ); + MDIChildren := Pointer( MDIClient.PropInt[ MDI_CHLDRN ] ); + MDIChildren.Remove( MDIChild ); MDIForm := MDIClient.ParentForm; - if MDIForm <> nil then - if MDIForm.fHandle <> 0 then - DrawMenuBar( MDIForm.fHandle ); + if MDIForm <> nil then + if MDIForm.fHandle <> 0 then + DrawMenuBar( MDIForm.fHandle ); MDIChild.Free; Result := TRUE; Exit; end; end; - if MDIChild.fNotAvailable then + if MDIChild.fAnchors and MDI_NOT_AVAILABLE <> 0 then begin - MDIChild.fNotAvailable := FALSE; - MDIChild.Invalidate; + MDIChild.fAnchors := MDIChild.fAnchors and not MDI_NOT_AVAILABLE; + MDIChild.Invalidate; end; end; -//[procedure CreateMDIChildExt] procedure CreateMDIChildExt( Sender: PControl ); var F: PControl; begin @@ -33296,50 +33295,51 @@ begin DrawMenuBar( F.fHandle ); end; -//[function NewMDIChild] function NewMDIChild( AParent: PControl; const ACaption: KOLString ): PControl; var MDIClient: PControl; + MDIChildren: PList; begin Assert( (AParent <> nil) and (AParent.ParentForm <> nil) and - (AParent.ParentForm.fMDIClient <> nil), 'Error creating MDI child' ); - MDIClient := AParent.ParentForm.fMDIClient; + (AParent.ParentForm.MDIClient <> nil), 'Error creating MDI child' ); + MDIClient := AParent.ParentForm.MDIClient; Result := NewForm( MDIClient, ACaption ); - Result.fIsMDIChild := TRUE; + {$IFDEF USE_FLAGS} include( Result.fFlagsG3, G3_IsMDIChild ); + {$ELSE} Result.fIsMDIChild := TRUE; {$ENDIF} Result.fMenu := CtlIdCount; Inc( CtlIdCount ); - MDIClient.fMDIChildren.Add( Result ); + MDIChildren := Pointer( MDIClient.PropInt[ MDI_CHLDRN ] ); + MDIChildren.Add( Result ); Result.fExStyle := Result.fExStyle or WS_EX_MDICHILD; - Result.fWndFunc := @ MDIChildFunc; + Result.PP.fWndFunc := @ MDIChildFunc; Result.fDefWndProc := @DefMDIChildProc; - Result.fPass2DefProc := Pass2DefMDIChildProc; + Result.PP.fPass2DefProc := Pass2DefMDIChildProc; Result.AttachProc( WndProcMDIChild ); Result.SubClassName := 'MDI_chld'; - Result.fNotAvailable := TRUE; - Result.fCreateWndExt := CreateMDIChildExt; + Result.fAnchors := Result.fAnchors or MDI_NOT_AVAILABLE; + Result.PP.fCreateWndExt := CreateMDIChildExt; end; //===================== Gradient panel ========================// {$IFDEF USE_CONSTRUCTORS} -//[function NewGradientPanel] function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl; begin new( Result, CreateGradientPanel( AParent, Color1, Color2 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:GradientPanel'; + {$ENDIF} end; -//[END NewGradientPanel] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewGradientPanel] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewGradientPanel( AParent: PControl; Color1, Color2: TColor ): PControl; begin Result := NewLabel( AParent, '' ); Result.AttachProc( WndProcGradient ); - Result.fColor2 := Color2; - Result.fColor1 := Color1; + Result.DF.fColor2 := Color2; + Result.DF.fColor1 := Color1; with Result.fBoundsRect do begin Right := Left + 40; @@ -33347,33 +33347,31 @@ begin end; 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:GradientPanelEx'; + {$ENDIF} end; -//[END NewGradientPanelEx] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewGradientPanelEx] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewGradientPanelEx( AParent: PControl; Color1, Color2: TColor; Style: TGradientStyle; Layout: TGradientLayout ): PControl; begin Result := NewLabel( AParent, '' ); Result.AttachProc( WndProcGradientEx ); - Result.fColor2 := Color2; - Result.fColor1 := Color1; - Result.fGradientStyle := Style; - Result.fGradientLayout := Layout; + Result.DF.fColor2 := Color2; + Result.DF.fColor1 := Color1; + Result.DF.fGradientStyle := Style; + Result.DF.fGradientLayout := Layout; with Result.fBoundsRect do begin Right := Left + 40; @@ -33381,7 +33379,6 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END NewGradientPanelEx] {$ENDIF USE_CONSTRUCTORS} @@ -33395,28 +33392,22 @@ const Editflags: array [ TEditOption ] of Integer = ( 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Editbox'; + {$ENDIF} end; -//[END NewEditbox] {$ELSE not_USE_CONSTRUCTORS} {$IFDEF _D3orHigher} function WndProcUnicodeChars( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; -var WStr: KOLString; +var WStr, WW: WideString; RepeatCount: Integer; begin Result := FALSE; - (*if (Msg.message = WM_KEYDOWN) and - (Msg.wParam = $E7 {VK_PACKET}) then - begin - Sender.fColumn := 1; - end - else*) - if //(Sender.fColumn = 1) and - (Msg.message = WM_CHAR) //and (Msg.wParam <> 8) + if (Msg.message = WM_CHAR) and (Msg.wParam >= 32) {$IFDEF UNICODE_CHAR_EXTCTL} and (GetKeyState(VK_CONTROL) >= 0) @@ -33432,24 +33423,18 @@ begin RepeatCount := Msg.lParam and $FFFF; if RepeatCount > 1 then begin + WW := WStr[1]; for RepeatCount := 2 to RepeatCount do - WStr := WStr + WStr[1]; + WStr := WStr + WW; end; - Sender.ReplaceSelection( WStr, TRUE ); + Sender.ReplaceSelection( KOLString( WStr ), TRUE ); end; Rslt := 0; - end - {else - if Msg.message = WM_KEYUP then - begin - Sender.fColumn := 0; - end}; + end; end; {$ENDIF _D3orHigher} -//[FUNCTION NewEditBox] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewEditbox( AParent: PControl; Options: TEditOptions ) : PControl; var Flags: Integer; begin @@ -33457,7 +33442,13 @@ begin if not(eoMultiline in Options) then Flags := Flags and not(WS_HSCROLL or WS_VSCROLL); Result := _NewControl( AParent, 'EDIT', WS_VISIBLE or WS_CHILD or WS_TABSTOP - or WS_BORDER or Flags, True, @EditActions ); + or WS_BORDER or Flags, True, + {$IFDEF PACK_COMMANDACTIONS} EditActions_Packed + {$ELSE} @EditActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Editbox'; + {$ENDIF} + Result.aAutoSzY := 6; with Result.fBoundsRect do begin Right := Left + 100; @@ -33466,14 +33457,15 @@ begin begin Right := Right + 100; Bottom := Top + 200; - Result.fIgnoreDefault := TRUE; + {$IFDEF USE_FLAGS} include( Result.fFlagsG5, G5_IgnoreDefault ); + {$ELSE} Result.fIgnoreDefault := TRUE; {$ENDIF} end; end; Result.fLookTabKeys := [ tkTab, tkUpDown, tkPageUpPageDn ]; - if eoMultiline in Options then - Result.fLookTabKeys := [ tkTab ]; - if eoWantTab in Options then - Result.fLookTabKeys := Result.fLookTabKeys - [ tkTab ]; + if eoMultiline in Options then + Result.fLookTabKeys := [ tkTab ]; + if eoWantTab in Options then + exclude( Result.fLookTabKeys, tkTab ); {$IFDEF UNICODE_CTRLS} {$IFDEF _D3orHigher} Result.AttachProc( WndProcUnicodeChars ); @@ -33481,7 +33473,6 @@ begin {$ENDIF} end; {$ENDIF ASM_VERSION} -//[END NewEditBox] {$ENDIF USE_CONSTRUCTORS} @@ -33496,15 +33487,15 @@ const ListFlags: array[TListOption] of Integer = ( LBS_OWNERDRAWVARIABLE, WS_HSCROLL ); {$IFDEF USE_CONSTRUCTORS} -//[function NewListbox] function NewListbox( AParent: PControl; Options: TListOptions ): PControl; begin new( Result, CreateListbox( AParent, Options ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Listbox'; + {$ENDIF} end; -//[END NewListbox] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewListbox] {$IFDEF ASM_UNICODE} const ListBoxClass : Array[ 0..7 ] of AnsiChar = ( 'L','I','S','T','B','O','X',#0 ); function NewListbox( AParent: PControl; Options: TListOptions ): PControl; @@ -33521,7 +33512,11 @@ asm XCHG ECX, EAX POP EAX PUSH 1 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [ListActions_Packed] + {$ELSE} PUSH offset[ListActions] + {$ENDIF} MOV EDX, offset[ListBoxClass] CALL _NewControl ADD [EAX].TControl.fBoundsRect.Right, 100 @@ -33536,7 +33531,12 @@ begin Flags := MakeFlags( @Options, ListFlags ); Result := _NewControl( AParent, 'LISTBOX', WS_VISIBLE or WS_CHILD or WS_TABSTOP or WS_BORDER or WS_VSCROLL - or LBS_NOTIFY or Flags, True, @ListActions ); + or LBS_NOTIFY or Flags, True, + {$IFDEF PACK_COMMANDACTIONS} ListActions_Packed + {$ELSE} @ListActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Listbox'; + {$ENDIF} with Result.fBoundsRect do begin Right := Right + 100; @@ -33546,16 +33546,13 @@ begin Result.fLookTabKeys := [ tkTab, tkLeftRight ]; end; {$ENDIF ASM_VERSION} -//[END NewListbox] {$ENDIF USE_CONSTRUCTORS} //===================== Combo box ========================// -//[FUNCTION ComboboxDropDown] {$IFNDEF USE_DROPDOWNCOUNT} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure ComboboxDropDown( Sender: PObj ); var CB: PControl; @@ -33573,10 +33570,10 @@ begin SetWindowPos( CB.Handle, 0, 0, 0, 0, 0, SWP_NOMOVE + SWP_NOSIZE + SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOREDRAW + SWP_SHOWWINDOW); - - if assigned( CB.fOnDropDown ) then - CB.fOnDropDown( CB ); - + {$IFDEF NIL_EVENTS} + if assigned( CB.EV.fOnDropDown ) then + {$ENDIF} + CB.EV.fOnDropDown( CB ); end; {$ENDIF ASM_VERSION} {$ELSE newcode} @@ -33588,29 +33585,27 @@ var ItemHeight: Integer; begin CB := PControl(Sender); - Count := CB.Count; DropDownCount := CB.DropDownCount; //DropDownCount := 8; - if (Count > DropDownCount) then - Count := DropDownCount; - if (Count < 1) then - Count := 1; + if (Count > DropDownCount) then + Count := DropDownCount; + if (Count < 1) then + Count := 1; ItemHeight := CB.Perform(CB_GETITEMHEIGHT, 0, 0); SetWindowPos( - CB.Handle, 0, 0, 0, CB.Width, ItemHeight * Count + CB.Height + 2, - SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOREDRAW or SWP_HIDEWINDOW); + CB.Handle, 0, 0, 0, CB.Width, ItemHeight * Count + CB.Height + 2, + SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_NOREDRAW or SWP_HIDEWINDOW); SetWindowPos( - CB.Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or - SWP_NOACTIVATE or SWP_NOREDRAW or SWP_SHOWWINDOW); - - if Assigned(CB.fOnDropDown) then - CB.fOnDropDown(CB); + CB.Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or + SWP_NOACTIVATE or SWP_NOREDRAW or SWP_SHOWWINDOW); + {$IFDEF NIL_EVENTS} + if Assigned(CB.EV.fOnDropDown) then + {$ENDIF} + CB.EV.fOnDropDown(CB); end; {$ENDIF USE_DROPDOWNCOUNT} -//[END ComboboxDropDown] -//[function WndFuncCombo] function WndFuncCombo( W: HWnd; Msg: Cardinal; wParam, lParam: Integer ) : Integer; stdcall; var Combo, Form: PControl; @@ -33638,11 +33633,16 @@ begin if fGlobalProcKeybd( Combo, MsgStruct, Result ) then Exit; if W <> Combo.FHandle then begin - if Assigned( Applet ) and Assigned( Applet.OnMessage ) then - if Applet.OnMessage( MsgStruct, Result ) then Exit; + if ( Applet <> nil ) + {$IFDEF NIL_EVENTS} and Assigned( Applet.EV.fOnMessage ) {$ENDIF} then + if Applet.EV.fOnMessage( MsgStruct, Result ) then + Exit; if (Applet <> Form) and (Form <> nil) then - if Assigned( Form.OnMessage ) then - if Form.OnMessage( MsgStruct, Result ) then Exit; + {$IFDEF NIL_EVENTS} + if Assigned( Form.EV.fOnMessage ) then + {$ENDIF} + if Form.EV.fOnMessage( MsgStruct, Result ) then + Exit; end; if (Combo.ToBeVisible) and ((Msg = WM_KEYDOWN) or (Msg = WM_KEYUP) or (Msg = WM_CHAR)) then @@ -33652,8 +33652,8 @@ begin begin case Msg of WM_KEYDOWN: - if Assigned( Combo.fGotoControl ) and - Combo.fGotoControl( Combo, wParam, FALSE ) then Exit; + if {$IFDEF NIL_EVENTS} Assigned( Combo.PP.fGotoControl ) and {$ENDIF} + Combo.PP.fGotoControl( Combo, wParam, FALSE ) then Exit; else Exit; end; end @@ -33664,8 +33664,8 @@ begin begin Combo.Perform( CB_SHOWDROPDOWN, 0, 0 ); if wParam = VK_ESCAPE then - Combo.Perform( CB_SETCURSEL, Combo.fCurIdxAtDrop, 0 ); - Combo.fWndProcKeybd( Combo, MsgStruct, Result ); + Combo.Perform( CB_SETCURSEL, Combo.DF.fCurIdxAtDrop, 0 ); + Combo.PP.fWndProcKeybd( Combo, MsgStruct, Result ); Exit; end {$IFDEF ESC_CLOSE_DIALOGS} @@ -33679,15 +33679,18 @@ begin {$ENDIF} end; {$IFDEF KEY_PREVIEW} - if not Form.KeyPreviewing then + if {$IFDEF USE_FLAGS} not(G4_Pushed in Form.fFlagsG4) + {$ELSE} not Form.fKeyPreviewing {$ENDIF} then begin - if Form.KeyPreview then + if {$IFDEF USE_FLAGS} G6_KeyPreview in Form.fFlagsG6 + {$ELSE} Form.fKeyPreview {$ENDIF} then begin - Form.KeyPreviewing := TRUE; - inc( Form.FKeyPreviewCount ); + {$IFDEF USE_FLAGS} include( Form.fFlagsG4, G4_Pushed ); + {$ELSE} Form.fKeyPreviewing := TRUE; {$ENDIF} + inc( Form.DF.FKeyPreviewCount ); //Form.Perform(Msg, wParam, lParam); - Form.fWndProcKeybd( Form, MsgStruct, Result ); - dec( Form.FKeyPreviewCount ); + Form.PP.fWndProcKeybd( Form, MsgStruct, Result ); + dec( Form.DF.fKeyPreviewCount ); if MsgStruct.wParam = 0 then begin Result := 0; @@ -33696,12 +33699,12 @@ begin end; end; {$ENDIF} - Combo.fWndProcKeybd( Combo, MsgStruct, Result ); + Combo.PP.fWndProcKeybd( Combo, MsgStruct, Result ); end else if Msg = WM_SETFOCUS then begin - if Form <> nil then Form.fCurrentControl := Combo; + if Form <> nil then Form.DF.fCurrentControl := Combo; end; MsgStruct.hwnd := W; //********************************************************* Added By M.Gerasimov @@ -33717,7 +33720,6 @@ begin Result := DefWindowProc( W, Msg, wParam, lParam ); end; -//[PROCEDURE CreateComboboxWnd] {$IFDEF ASM_UNICODE} procedure CreateComboboxWnd( Combo: PControl ); //const PrevProcStr: PAnsiChar = 'PREV_PROC'; //************ Remarked By M.Gerasimov @@ -33764,9 +33766,7 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END CreateComboboxWnd] -//[procedure RemoveChldPrevProc] procedure RemoveChldPrevProc( fHandle: HWnd ); var Chld: HWnd; begin @@ -33779,7 +33779,6 @@ begin end; end; -//[function WndProcCombo] function WndProcCombo( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; {$IFDEF UNICODE_CTRLS} var s: KOLString; @@ -33796,7 +33795,8 @@ begin else if (Msg.message >= CN_CTLCOLORMSGBOX) and (Msg.message <= CN_CTLCOLORSTATIC) then begin - if Sender.fTransparent then + if {$IFDEF USE_FLAGS} G2_Transparent in Sender.fFlagsG2 + {$ELSE} Sender.fTransparent {$ENDIF} then case Msg.message of CN_CTLCOLORLISTBOX: begin @@ -33813,14 +33813,16 @@ begin case HiWord( Msg.wParam ) of CBN_DROPDOWN: begin - Sender.fDropped := True; - Sender.fCurIdxAtDrop := Sender.CurIndex; - Sender.fDropDownProc( Sender ); + Sender.DF.fCurIdxAtDrop := Sender.CurIndex; + //Sender.fDropDownProc( Sender ); + ComboboxDropDown( Sender ); end; CBN_CLOSEUP: begin - Sender.fDropped := False; - if Assigned( Sender.fOnCloseUp ) then Sender.fOnCloseUp( Sender ); + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnCloseUp ) then + {$ENDIF} + Sender.EV.fOnCloseUp( Sender ); end; CBN_SELCHANGE: begin @@ -33836,9 +33838,11 @@ begin if (Msg.message = CB_INSERTSTRING) or (Msg.message = CB_ADDSTRING) then begin - if not Sender.fIsButton then + if {$IFDEF USE_FLAGS} not(G5_IsButton in Sender.fFlagsG5) + {$ELSE} not Sender.fIsButton {$ENDIF} then begin - Sender.fIsButton := TRUE; + {$IFDEF USE_FLAGS} Include( Sender.fFlagsG5, G5_IsButton ); + {$ELSE} Sender.fIsButton := TRUE; {$ENDIF} w := Pointer( Msg.lParam ); L := WStrLen( w ); SetLength( s, L ); @@ -33846,7 +33850,8 @@ begin Rslt := SendMessageW( Msg.hwnd, Msg.message, Msg.wParam, Integer( @s[1] ) ); Result := TRUE; - Sender.fIsButton := FALSE; + {$IFDEF USE_FLAGS} Exclude( Sender.fFlagsG5, G5_IsButton ); + {$ELSE} Sender.fIsButton := FALSE; {$ENDIF} end; end; {$ENDIF} @@ -33859,16 +33864,16 @@ const ComboFlags: array[ TComboOption ] of Integer = ( CBS_OWNERDRAWFIXED, CBS_OWNERDRAWVARIABLE, CBS_SIMPLE ); {$IFDEF USE_CONSTRUCTORS} -//[function NewCombobox] function NewCombobox( AParent: PControl; Options: TComboOptions ): PControl; begin new( Result, CreateCombobox( AParent, Options ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Combobox'; + {$ENDIF} end; {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewCombobox] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewCombobox( AParent: PControl; Options: TComboOptions ): PControl; var Flags: Integer; begin @@ -33881,10 +33886,17 @@ begin or WS_VSCROLL or CBS_HASSTRINGS or WS_TABSTOP or Flags - , True, @ComboActions ); - //Result.fCannotDoubleBuf := TRUE; - Result.fCreateWndExt := CreateComboboxWnd; - Result.fDropDownProc := ComboboxDropDown; + ,True, + {$IFDEF PACK_COMMANDACTIONS} ComboActions_Packed + {$ELSE} @ComboActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Combobox'; + {$ENDIF} + {$IFDEF PACK_COMMANDACTIONS} + Result.fCommandActions.aClear := @ClearCombobox; + {$ENDIF} + Result.aAutoSzY := 6; + Result.PP.fCreateWndExt := CreateComboboxWnd; Result.fClsStyle := Result.fClsStyle or CS_DBLCLKS; with Result.fBoundsRect do begin @@ -33900,11 +33912,9 @@ begin {$ENDIF} end; {$ENDIF ASM_VERSION} -//[END NewCombobox] {$ENDIF USE_CONSTRUCTORS} -//[FUNCTION WndProcResiz] {$IFDEF ASM_TLIST} function WndProcResize(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; asm @@ -33945,11 +33955,8 @@ begin Result := False; // don't stop further processing end; {$ENDIF ASM_VERSION} -//[END WndProcResiz] -//[FUNCTION WndProcParentResize] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProcParentResize(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin Result := False; @@ -33961,22 +33968,40 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END WndProcParentResize] -//[procedure InitCommonControlCommonNotify] +{$IFDEF ASM_VERSION} +procedure InitCommonControlCommonNotify( Ctrl: PControl ); +asm + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG5, 1 shl G5_IsCommonCtl + {$ELSE} + MOV [EAX].TControl.fIsCommonControl, 1 + {$ENDIF} + MOV ECX, [EAX].TControl.fParent + JECXZ @@fin + PUSH ECX + MOV EDX, offset[WndProcCommonNotify] + CALL TControl.AttachProc + POP EAX + MOV EDX, offset[WndProcNotify] + CALL TControl.AttachProc +@@fin: +end; +{$ELSE PASCAL} procedure InitCommonControlCommonNotify( Ctrl: PControl ); var AParent: PControl; begin - Ctrl.fIsCommonControl := True; + {$IFDEF USE_FLAGS} include( Ctrl.fFlagsG5, G5_IsCommonCtl ); + {$ELSE} Ctrl.fIsCommonControl := True; {$ENDIF} AParent := Ctrl.Parent; - if AParent <> nil then + if AParent <> nil then begin - Ctrl.AttachProc( WndProcCommonNotify ); - AParent.AttachProc( WndProcNotify ); + Ctrl.AttachProc( WndProcCommonNotify ); + AParent.AttachProc( WndProcNotify ); end; end; +{$ENDIF ASM_VERSION} -//[procedure InitCommonControlSizeNotify] procedure InitCommonControlSizeNotify( Ctrl: PControl ); var AParent: PControl; begin @@ -33988,33 +34013,39 @@ begin end; end; -//[function _NewCommonControl] function _NewCommonControl( AParent: PControl; ClassName: PKOLChar; Style: DWORD; - Ctl3D: Boolean; Actions: PCommandActions ): PControl; + Ctl3D: Boolean; Actions: TCommandActionsParam ): PControl; begin {*************} DoInitCommonControls( ICC_WIN95_CLASSES ); Result := _NewControl( AParent, ClassName, Style, Ctl3D, Actions ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:CommonControl'; + {$ENDIF} InitCommonControlCommonNotify( Result ); end; //==================== Progress bar ======================// {$IFDEF USE_CONSTRUCTORS} -//[function NewProgressbar] function NewProgressbar( AParent: PControl ): PControl; begin new( Result, CreateProgressbar( AParent ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Progressbar'; + {$ENDIF} end; -//[END NewProgressbar] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewProgressbar] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewProgressbar( AParent: PControl ): PControl; begin Result := _NewCommonControl( AParent, PROGRESS_CLASS, - WS_CHILD or WS_VISIBLE, True, nil ); + WS_CHILD or WS_VISIBLE, True, + {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( PROGRESS_ACTIONS ) + {$ELSE} nil {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:ProgressBar'; + {$ENDIF} with Result.fBoundsRect do begin Right := Left + 300; @@ -34026,39 +34057,35 @@ begin //Result.fNCDestroyed := TRUE; // do not call DestroyWindow! 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:ProgressBarEx'; + {$ENDIF} end; -//[END NewProgressbarEx] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewProgressbarEx] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PControl; const ProgressBarFlags: array[ TProgressbarOption ] of Integer = (PBS_VERTICAL, PBS_SMOOTH ); begin Result := NewProgressbar( AParent ); - Result.fStyle := Result.fStyle or DWORD( MakeFlags( @Options, ProgressBarFlags ) ); + Result.fStyle.Value := Result.fStyle.Value or + DWORD( MakeFlags( @Options, ProgressBarFlags ) ); end; {$ENDIF ASM_VERSION} -//[END NewProgressbarEx] {$ENDIF USE_CONSTRUCTORS} //===================== List view ========================// -//[FUNCTION WndProcNotify] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProcNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var NMhdr: PNMHdr; Child: PControl; @@ -34082,11 +34109,8 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END WndProcNotify] -//[FUNCTION WndProcCommonNotify] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProcCommonNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var NMhdr: PNMHdr; begin @@ -34096,22 +34120,30 @@ begin NMHdr := Pointer( Msg.lParam ); case NMHdr.code of NM_RCLICK, - NM_CLICK: if assigned( Self_.fOnClick ) then + NM_CLICK: {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnClick ) then + {$ENDIF} begin - Self_.fRightClick := NMHdr.code=NM_RCLICK; - Self_.fOnClick( Self_ ); - Result := TRUE; + {$IFDEF USE_FLAGS} + if NMHdr.code = NM_RCLICK then + include( Self_.fFlagsG6, G6_RightClick ) + else exclude( Self_.fFlagsG6, G6_RightClick ); + {$ELSE} Self_.fRightClick := NMHdr.code=NM_RCLICK; {$ENDIF} + Self_.EV.fOnClick( Self_ ); end; - NM_KILLFOCUS: if assigned( Self_.fOnLeave ) then - Self_.fOnLeave( Self_ ); + NM_KILLFOCUS: {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnLeave ) then + {$ENDIF} + Self_.EV.fOnLeave( Self_ ); NM_RETURN, - NM_SETFOCUS: if assigned( Self_.fOnEnter ) then - Self_.fOnEnter( Self_ ); + NM_SETFOCUS: {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnEnter ) then + {$ENDIF} + Self_.EV.fOnEnter( Self_ ); end; end; end; {$ENDIF ASM_VERSION} -//[END WndProcCommonNotify] const ListViewStyles: array[ TListViewStyle ] of DWORD = ( LVS_ICON, LVS_SMALLICON, LVS_LIST, LVS_REPORT, LVS_REPORT or LVS_NOCOLUMNHEADER ); @@ -34129,9 +34161,7 @@ const ListViewStyles: array[ TListViewStyle ] of DWORD = ( LVS_ICON, LVS_SMALLIC LVS_EX_TWOCLICKACTIVATE, LVS_EX_FLATSB, LVS_EX_REGIONAL, LVS_EX_INFOTIP, LVS_EX_UNDERLINEHOT, LVS_EX_MULTIWORKAREAS, 0, 0 ); -//[FUNCTION ApplyImageLists2Control] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure ApplyImageLists2Control( Sender: PControl ); var IL: PImageList; begin @@ -34147,50 +34177,51 @@ begin Sender.Perform( Sender.fCommandActions.aSetImgList, LVSIL_STATE, IL.Handle ); end; {$ENDIF ASM_VERSION} -//[END ApplyImageLists2Control] -//[FUNCTION ApplyImageLists2ListView] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure ApplyImageLists2ListView( Sender: PControl ); var Flags: DWORD; begin - Flags := MakeFlags( @Sender.fLVOptions, ListViewFlags ); + Flags := MakeFlags( @Sender.DF.fLVOptions, ListViewFlags ); Sender.Style := Sender.Style and not $403F//$4FFC - or Flags or ListViewStyles[ Sender.fLVStyle ]; - Flags := MakeFlags( @Sender.fLVOptions, ListViewExFlags ); + or Flags or ListViewStyles[ Sender.DF.fLVStyle ]; + Flags := MakeFlags( @Sender.DF.fLVOptions, ListViewExFlags ); Sender.Perform( LVM_SETEXTENDEDLISTVIEWSTYLE, $3FFF, Flags ); ApplyImageLists2Control( Sender ); 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:ListView'; + {$ENDIF} end; -//[END NewListView] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewListView] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewListView( AParent: PControl; Style: TListViewStyle; Options: TListViewOptions; ImageListSmall, ImageListNormal, ImageListState: PImageList ): PControl; begin Result := _NewCommonControl( AParent, WC_LISTVIEW, ListViewStyles[ Style ] or LVS_SHAREIMAGELISTS or WS_CHILD or WS_VISIBLE or WS_TABSTOP or WS_CLIPCHILDREN, - True, @ListViewActions ); - - Result.fLVOptions := Options; - Result.fLVStyle := Style; - Result.fStyle := Result.fStyle and not LVS_TYPESTYLEMASK + True, {$IFDEF PACK_COMMANDACTIONS} ListViewActions_Packed + {$ELSE} @ListViewActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:ListView'; + {$ENDIF} + {$IFDEF PACK_COMMANDACTIONS} + Result.fCommandActions.aClear := @ClearListView; + {$ENDIF} + Result.DF.fLVOptions := Options; + Result.DF.fLVStyle := Style; + Result.fStyle.Value := Result.fStyle.Value and not LVS_TYPESTYLEMASK or DWORD( MakeFlags( @Options, ListViewFlags ) ); - Result.fCreateWndExt := ApplyImageLists2ListView; + Result.PP.fCreateWndExt := ApplyImageLists2ListView; with Result.fBoundsRect do begin Right := Left + 200; @@ -34199,18 +34230,16 @@ begin Result.ImageListSmall := ImageListSmall; Result.ImageListNormal := ImageListNormal; Result.ImageListState := ImageListState; - Result.fLVTextBkColor := clWindow; + Result.DF.fLVTextBkColor := clWindow; Result.fLookTabKeys := [ tkTab ]; //Result.fMargin := 0; end; {$ENDIF ASM_VERSION} -//[END NewListView] {$ENDIF USE_CONSTRUCTORS} //===================== Tree view ========================// -//[FUNCTION WndProcTreeView] {$IFDEF ASM_UNICODE} function WndProcTreeView( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; asm //cmd //opd @@ -34219,7 +34248,12 @@ asm //cmd //opd PUSH EBX XCHG EBX, EAX MOV EDX, [EDX].TMsg.lParam - LEA EAX, [EBX].TControl.fOnTVBeginDrag + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EBX].TControl.EV + LEA EAX, [EAX].TEvents.fOnTVBeginDrag + {$ELSE} + LEA EAX, [EBX].TControl.EV.fOnTVBeginDrag + {$ENDIF} CMP word ptr [EDX].TNMTreeView.hdr.code, NM_RCLICK JNE @@chk_TVN_BEGINDRAG PUSH ECX @@ -34265,7 +34299,12 @@ asm //cmd //opd CALL EBX @@2fin_false1: JMP @@fin_false @@chk_BEGINLABELEDIT: - LEA EAX, [EBX].TControl.fOnTVBeginEdit + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EBX].TControl.EV + LEA EAX, [EAX].TEvents.FOnTVBeginEdit + {$ELSE} + LEA EAX, [EBX].TControl.EV.fOnTVBeginEdit + {$ENDIF} {$IFDEF UNICODE_CTRLS} CMP word ptr [EDX].TNMTreeView.hdr.code, TVN_BEGINLABELEDITW JZ @@beginlabeledit @@ -34273,8 +34312,11 @@ asm //cmd //opd CMP word ptr [EDX].TNMTreeView.hdr.code, TVN_BEGINLABELEDIT JNZ @@chk_ITEMEXPANDED //@@chk_DELETEITEM @@beginlabeledit: - + {$IFDEF USE_FLAGS} + TEST [EBX].TControl.fFlagsG6, 1 shl G6_Dragging + {$ELSE} CMP [EBX].TControl.fDragging, 0 + {$ENDIF} JZ @@allow_LABELEDIT XOR EAX, EAX INC EAX @@ -34295,8 +34337,6 @@ asm //cmd //opd TEST AL, AL SETZ AL // Rslt := not event result; POP EBX - JZ @@ret_EAX - INC [EBX].TControl.fEditing JMP @@ret_EAX @@call_EBX: @@ -34304,7 +34344,12 @@ asm //cmd //opd @@2fin_false: JMP @@fin_false @@chk_ITEMEXPANDED: - LEA EAX, [EBX].TControl.fOnTVExpanded + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EBX].TControl.EV + LEA EAX, [EAX].TEvents.fOnTVExpanded + {$ELSE} + LEA EAX, [EBX].TControl.EV.fOnTVExpanded + {$ENDIF} {$IFDEF UNICODE_CTRLS} CMP word ptr [EDX].TNMTreeView.hdr.code, TVN_ITEMEXPANDEDW JZ @@itemexpanded @@ -34323,7 +34368,12 @@ asm //cmd //opd CMP word ptr [EDX].TNMTreeView.hdr.code, TVN_SELCHANGING JNE @@chk_ITEMEXPANDING XCHG EAX, ECX - MOV ECX, [EBX].TControl.fOnTVSelChanging.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV ECX, [EBX].TControl.EV + MOV ECX, [ECX].TEvents.fOnTVSelChanging.TMethod.Code + {$ELSE} + MOV ECX, [EBX].TControl.EV.fOnTVSelChanging.TMethod.Code + {$ENDIF} @@2fin_false2: JECXZ @@2fin_false PUSH EAX //@Rslt @@ -34331,7 +34381,12 @@ asm //cmd //opd XCHG ECX, EBX //EBX=OnTVSelChanging.Code ECX=Sender XCHG ECX, EDX //EDX=Sender ECX=Msg MOV ECX, [ECX].TNMTreeView.itemOld.hItem - MOV EAX, [EDX].TControl.fOnTVSelChanging.TMethod.Data + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EDX].TControl.EV + MOV EAX, [EAX].TEvents.fOnTVSelChanging.TMethod.Data + {$ELSE} + MOV EAX, [EDX].TControl.EV.fOnTVSelChanging.TMethod.Data + {$ENDIF} CALL EBX XOR AL, 1 MOVZX EAX, AL @@ -34346,7 +34401,12 @@ asm //cmd //opd JNE @@chk_ENDLABELEDIT @@itemexpanding: XCHG EAX, ECX - MOV ECX, [EBX].TControl.fOnTVExpanding.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV ECX, [EBX].TControl.EV + MOV ECX, [ECX].TEvents.fOnTVExpanding.TMethod.Code + {$ELSE} + MOV ECX, [EBX].TControl.EV.fOnTVExpanding.TMethod.Code + {$ENDIF} JECXZ @@2fin_false2 PUSH EAX // @Rslt CMP [EDX].TNMTreeView.action, TVE_EXPAND @@ -34356,7 +34416,12 @@ asm //cmd //opd XCHG ECX, EBX //EBX=OnTVExpanding.Code ECX=Seneder XCHG EDX, ECX //ECX=Msg EDX=Sender MOV ECX, [ECX].TNMTreeView.itemNew.hItem //ECX=Item - MOV EAX, [EDX].TControl.fOnTVExpanding.TMethod.Data //EAX=object + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EDX].TControl.EV + MOV EAX, [EAX].TEvents.fOnTVExpanding.TMethod.Data + {$ELSE} + MOV EAX, [EDX].TControl.EV.fOnTVExpanding.TMethod.Data //EAX=object + {$ENDIF} @@111: CALL EBX @@ret_EAX: @@ -34376,9 +34441,13 @@ asm //cmd //opd CMP word ptr [EDX].TNMTreeView.hdr.code, TVN_ENDLABELEDIT JNZ @@chk_SELCHANGED @@endlabeledit: - MOV [EBX].TControl.fEditing, 0 XCHG EAX, ECX - MOV ECX, [EBX].TControl.fOnTVEndEdit.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV ECX, [EBX].TControl.EV + MOV ECX, [ECX].TEvents.fOnTVEndEdit.TMethod.Code + {$ELSE} + MOV ECX, [EBX].TControl.EV.fOnTVEndEdit.TMethod.Code + {$ENDIF} JECXZ @@ret_1 PUSH EAX PUSH EBX @@ -34419,7 +34488,12 @@ asm //cmd //opd POP EAX PUSH EAX PUSH EAX - MOV EAX, [EDX].TControl.fOnTVEndEdit.TMethod.Data + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EDX].TControl.EV + MOV EAX, [EAX].TEvents.fOnTVEndEdit.TMethod.Data + {$ELSE} + MOV EAX, [EDX].TControl.EV.fOnTVEndEdit.TMethod.Data + {$ENDIF} MOV EBX, [EBX].TTVDispInfo.item.hItem XCHG ECX, EBX CALL EBX @@ -34467,89 +34541,85 @@ begin PostMessage( Self_.fHandle, WM_RBUTTONUP, MK_RBUTTON or GetShiftState, (P.x and $FFFF) or (P.y shl 16) ); end; - (*{$IFNDEF UNICODE_CTRLS} - TVN_BEGINDRAGW, TVN_BEGINRDRAGW, 1 - {$ENDIF}*) TVN_BEGINDRAG {$IFDEF TV_DRAG_RBUTTON}, TVN_BEGINRDRAG{$ENDIF}: - if Assigned( Self_.fOnTVBeginDrag ) then - Self_.fOnTVBeginDrag( Self_, NM.itemNew.hItem ); - TVN_BEGINLABELEDIT - (*{$IFNDEF UNICODE_CTRLS}, TVN_BEGINLABELEDITW{$ENDIF}*): + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnTVBeginDrag ) then + {$ENDIF} + Self_.EV.fOnTVBeginDrag( Self_, NM.itemNew.hItem ); + TVN_BEGINLABELEDIT: begin - if Self_.fDragging then - begin - Rslt := 1; // do not allow edit while dragging - Result := TRUE; - Exit; - end; - DI := Pointer( NM ); - if Assigned( Self_.fOnTVBeginEdit ) then - begin - Rslt := Integer( not Self_.fOnTVBeginEdit( Self_, DI.item.hItem ) ); - if Rslt = 0 then - Self_.fEditing := TRUE; - Result := TRUE; - Exit; - end; - end; - TVN_ENDLABELEDIT - (*{$IFNDEF UNICODE_CTRLS}, TVN_ENDLABELEDITW {$ENDIF}*): - begin - DI := Pointer( NM ); - if Assigned( Self_.fOnTVEndEdit ) then - begin - S := DI.item.pszText; - if (DI.item.pszText = nil) then - begin - Self_.fEditing := FALSE; - Result := True; - Exit; - end; - if Self_.fOnTVEndEdit( Self_, DI.item.hItem, S ) then Rslt := 1 - else Rslt := 0; - end - else - Rslt := 1; - Self_.fEditing := FALSE; - Result := True; - Exit; - end; - TVN_ITEMEXPANDING - (*{$IFNDEF UNICODE_CTRLS}, TVN_ITEMEXPANDINGW {$ENDIF}*): - begin - if Assigned( Self_.fOnTVExpanding ) then - begin - Rslt := Integer( Self_.fOnTVExpanding( Self_, NM.itemNew.hItem, - NM.action = TVE_EXPAND ) ); - Result := TRUE; - Exit; - end; - end; - TVN_ITEMEXPANDED - (*{$IFNDEF UNICODE_CTRLS}, TVN_ITEMEXPANDEDW {$ENDIF}*): - if Assigned( Self_.fOnTVExpanded ) then - Self_.fOnTVExpanded( Self_, NM.itemNew.hItem, NM.action=TVE_EXPAND ); - TVN_SELCHANGING - (*{$IFNDEF UNICODE_CTRLS}, TVN_SELCHANGINGW {$ENDIF}*): - begin //------------------ TVN_SELCHANGING by Sergey Shisminzev - if Assigned( Self_.fOnTVSelChanging ) then + if {$IFDEF USE_FLAGS} G6_Dragging in Self_.fFlagsG6 + {$ELSE} Self_.fDragging {$ENDIF} then begin - Rslt := Integer( not Self_.fOnTVSelChanging( Self_, NM.itemOld.hItem, NM.itemNew.hItem ) ); - Result := TRUE; - Exit; + Rslt := 1; // do not allow edit while dragging + Result := TRUE; + Exit; + end; + DI := Pointer( NM ); + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnTVBeginEdit ) then + {$ENDIF} + begin + Rslt := Integer( not Self_.EV.fOnTVBeginEdit( Self_, DI.item.hItem ) ); + Result := TRUE; + Exit; + end; + end; + TVN_ENDLABELEDIT: + begin + DI := Pointer( NM ); + if Assigned( Self_.EV.fOnTVEndEdit ) then + begin + S := DI.item.pszText; + if (DI.item.pszText = nil) then + begin + Result := True; + Exit; + end; + Rslt := Integer( + Self_.EV.fOnTVEndEdit( Self_, DI.item.hItem, S ) ); + end + else + Rslt := 1; + Result := True; + Exit; + end; + TVN_ITEMEXPANDING: + begin + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnTVExpanding ) then + {$ENDIF} + begin + Rslt := Integer( Self_.EV.fOnTVExpanding( Self_, NM.itemNew.hItem, + NM.action = TVE_EXPAND ) ); + //Result := TRUE; + //Exit; + end; + end; + TVN_ITEMEXPANDED: + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnTVExpanded ) then + {$ENDIF} + Self_.EV.fOnTVExpanded( Self_, NM.itemNew.hItem, NM.action=TVE_EXPAND ); + TVN_SELCHANGING: + begin //------------------ TVN_SELCHANGING by Sergey Shisminzev + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnTVSelChanging ) then + {$ENDIF} + begin + Rslt := Integer( not Self_.EV.fOnTVSelChanging( Self_, NM.itemOld.hItem, NM.itemNew.hItem ) ); + //Result := TRUE; + //Exit; end; end; //---------------------------------------- - TVN_SELCHANGED - (*{$IFNDEF UNICODE_CTRLS}, TVN_SELCHANGEDW {$ENDIF}*): + TVN_SELCHANGED: Self_.DoSelChange; end; end; Result := False; end; {$ENDIF ASM_VERSION} -//[END WndProcTreeView] -//[function ProcTVDeleteItem] function ProcTVDeleteItem( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var NM: PNMTreeView; begin @@ -34558,14 +34628,15 @@ begin NM := Pointer( Msg.lParam ); case NM.hdr.code of TVN_DELETEITEM: - if Assigned( Self_.fOnTVDelete ) then - Self_.fOnTVDelete( Self_, NM.itemOld.hItem ); + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnTVDelete ) then + {$ENDIF} + Self_.EV.fOnTVDelete( Self_, NM.itemOld.hItem ); end; end; Result := FALSE; end; -//[procedure ClearTreeView] procedure ClearTreeView( TV: PControl ); begin TV.TVDelete( TVI_ROOT ); @@ -34574,30 +34645,37 @@ end; const TreeViewFlags: array[ TTreeViewOption ] of Integer = ( not TVS_HASLINES, TVS_LINESATROOT, not TVS_HASBUTTONS, TVS_EDITLABELS, not TVS_SHOWSELALWAYS, - not TVS_DISABLEDRAGDROP, TVS_NOTOOLTIPS, TVS_CHECKBOXES, - TVS_TRACKSELECT, TVS_SINGLEEXPAND, TVS_INFOTIP, - TVS_FULLROWSELECT, TVS_NOSCROLL, TVS_NONEVENHEIGHT ); + not TVS_DISABLEDRAGDROP, TVS_NOTOOLTIPS, TVS_CHECKBOXES, + 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:TreeView'; + {$ENDIF} end; {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewTreeView] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewTreeView( AParent: PControl; Options: TTreeViewOptions; ImgListNormal, ImgListState: PImageList ): PControl; var Flags: Integer; begin Flags := MakeFlags( @Options, TreeViewFlags ); Result := _NewCommonControl( AParent, WC_TREEVIEW, Flags or WS_VISIBLE or - WS_CHILD or WS_TABSTOP, True, @TreeViewActions ); - Result.fCreateWndExt := ApplyImageLists2Control; + WS_CHILD or WS_TABSTOP, True, {$IFDEF PACK_COMMANDACTIONS} TreeViewActions_Packed + {$ELSE} @TreeViewActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:TreeView'; + {$ENDIF} + {$IFDEF PACK_COMMANDACTIONS} + Result.fCommandActions.aClear := @ClearTreeView; + {$ENDIF} + Result.PP.fCreateWndExt := ApplyImageLists2Control; Result.fColor := clWindow; Result.AttachProc( WndProcTreeView ); with Result.fBoundsRect do @@ -34610,15 +34688,12 @@ begin Result.fLookTabKeys := [ tkTab ]; end; {$ENDIF ASM_VERSION} -//[END NewTreeView] {$ENDIF USE_CONSTRUCTORS} //===================== Tab Control ========================// -//[FUNCTION WndProcTabControl] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProcTabControl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Hdr: PNMHdr; A: Integer; @@ -34647,9 +34722,11 @@ begin if A = I then Page.BringToFront; end; - if not WasActive then - if Assigned( Self_.fOnSelChange ) then - Self_.fOnSelChange( Self_ ); + if not WasActive then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnSelChange ) then + {$ENDIF} + Self_.EV.fOnSelChange( Self_ ); end; end; end; @@ -34680,9 +34757,11 @@ begin Self_.fCurIndex := A; Self_.Pages[Self_.fCurIndex].Visible := true; Self_.Pages[Self_.fCurIndex].BringToFront; - if not WasActive then - if Assigned( Self_.fOnSelChange ) then - Self_.fOnSelChange( Self_ ); + if not WasActive then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnSelChange ) then + {$ENDIF} + Self_.EV.fOnSelChange( Self_ ); end; end; end; @@ -34702,7 +34781,6 @@ begin Result := False; end; {$ENDIF ASM_VERSION} -//[END WndProcTabControl] {$IFDEF GRAPHCTL_XPSTYLES} {$DEFINE RICHEDIT_XPBORDER} @@ -34728,11 +34806,9 @@ begin EmptyRect := DrawRect; with DrawRect do ExcludeClipRect(DC, Left + 2, Top + 2, Right - 2, Bottom - 2); - //Details := GetElementDetails(teEditTextNormal); Details.Element := teEdit; Details.Part := 1 {EP_EDITTEXT}; Details.State := Ord(teEditTextNormal) - Ord(teEditTextNormal) + 1; - //DrawElement(DC, Details, DrawRect); if not Assigned( DrawThemeBackground ) then begin ThemeLibrary := LoadLibrary(themelib); @@ -34762,16 +34838,16 @@ const TabControlFlags: array[ TTabControlOption ] of Integer = ( TCS_BUTTONS, 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:TabControl'; + {$ENDIF} end; -//[END NewTabControl] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewTabControl] {$IFDEF ASM_UNICODE} function NewTabControl( AParent: PControl; const Tabs: array of PKOLChar; Options: TTabControlOptions; ImgList: PImageList; ImgList1stIdx: Integer ): PControl; @@ -34796,7 +34872,11 @@ asm //cmd //opd XCHG EAX, EBX MOV EDX, offset[WC_TABCONTROL] PUSH 1 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [TabControlActions_Packed] + {$ELSE} PUSH offset[TabControlActions] + {$ENDIF} CALL _NewCommonControl MOV EBX, EAX TEST [Options], 2 shl (tcoBorder - 1) @@ -34853,8 +34933,12 @@ begin if tcoFocusTabs in Options then Flags := Flags or (WS_TABSTOP or TCS_FOCUSONBUTTONDOWN); Result := _NewCommonControl( AParent, WC_TABCONTROL, - Flags or (WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_VISIBLE), True, - @TabControlActions ); + Flags or (WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_VISIBLE), + True, {$IFDEF PACK_COMMANDACTIONS} TabControlActions_Packed + {$ELSE} @TabControlActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:TabControl'; + {$ENDIF} if not( tcoBorder in Options ) then begin Result.fExStyle := Result.fExStyle and not WS_EX_CLIENTEDGE; @@ -34876,12 +34960,9 @@ begin Result.fLookTabKeys := [ tkTab ]; end; {$ENDIF ASM_VERSION} -//[END NewTabControl] {$IFNDEF OLD_ALIGN} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal -//[FUNCTION NewTabEmpty] +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewTabEmpty( AParent: PControl; Options: TTabControlOptions; ImgList: PImageList ): PControl; var Flags: Integer; @@ -34890,8 +34971,12 @@ begin if tcoFocusTabs in Options then Flags := Flags or (WS_TABSTOP or TCS_FOCUSONBUTTONDOWN); Result := _NewCommonControl( AParent, WC_TABCONTROL, - Flags or (WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_VISIBLE), True, - @TabControlActions ); + Flags or (WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_VISIBLE), + True, {$IFDEF PACK_COMMANDACTIONS} TabControlActions_Packed + {$ELSE} @TabControlActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:TabControl(TabEmpty)'; + {$ENDIF} if not( tcoBorder in Options ) then Result.fExStyle := Result.fExStyle and not WS_EX_CLIENTEDGE; Result.AttachProc( WndProcTabControl ); @@ -34904,14 +34989,12 @@ begin Result.fLookTabKeys := [ tkTab ]; end; {$ENDIF ASM_VERSION} -//[END NewTabEmpty] {$ENDIF} {$ENDIF USE_CONSTRUCTORS} //===================== Tool bar ========================// -//[FUNCTION WndProcToolbarCtr] {$IFDEF ASM_noVERSION} //TTN_NEEDTEXTW ASM_TLIST! function WndProcToolbarCtrl(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; asm @@ -34941,11 +35024,18 @@ asm PUSH VK_RETURN CALL GetKeyState TEST EAX, EAX - SETL DL POP ECX POP EAX MOV [EAX].TControl.fCurIndex, ECX + {$IFDEF USE_FLAGS} + SETL DL + SHL DL, G6_RightClick + AND [EAX].TControl.fFlagsG6, not(1 shl G6_RightClick) + OR [EAX].TControl.fFlagsG6, DL + {$ELSE} + SETL DL MOV [EAX].TControl.fRightClick, DL + {$ENDIF} @@ret_false: XOR EAX, EAX RET @@ -34960,7 +35050,7 @@ asm PUSH EAX PUSH EDX MOV EDX, [EDX].TTooltipText.hdr.idFrom - MOV ECX, [EAX].TControl.fTBttCmd + MOV ECX, [EAX].TControl.DF.fTBttCmd OR EAX, -1 JECXZ @@idxReady XCHG EAX, ECX @@ -34972,7 +35062,7 @@ asm MOV byte ptr [EDX], 0 POP ECX JL @@ret_true - MOV ECX, [ECX].TControl.fTBttTxt + MOV ECX, [ECX].TControl.DF.fTBttTxt MOV ECX, [ECX].TStrList.fList MOV ECX, [ECX].TList.fItems MOV EAX, [ECX+EAX*4] @@ -35035,24 +35125,30 @@ var WStr: WideString; {$ENDIF _FPC} begin Result := False; - if Msg.message = WM_WINDOWPOSCHANGED then + if Msg.message = WM_WINDOWPOSCHANGED then begin - if Assigned( Self_.fOnResize ) then - Self_.fOnResize( Self_ ); - {$IFNDEF TOOLBAR_FORCE_CHILDALIGN} - //-- removed by MTsv DN (v.290), crash in Win 98: - //-- if WinVer >= wvNT then // todo: check it. - Result := TRUE; // this provides (prevents?) the Align working for child controls of Toolbar ! - // but removing this line makes it impossible to correct the Align property for - // the neighbour controls on form!!! - {$ENDIF} - Rslt := 0; + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnResize ) then + {$ENDIF} + Self_.EV.fOnResize( Self_ ); + {$IFNDEF TOOLBAR_FORCE_CHILDALIGN} + //-- removed by MTsv DN (v.290), crash in Win 98: + //-- if WinVer >= wvNT then // todo: check it. + Result := TRUE; // this provides (prevents?) the Align working for child controls of Toolbar ! + // but removing this line makes it impossible to correct the Align property for + // the neighbour controls on form!!! + {$ENDIF} + Rslt := 0; end else if Msg.message = CM_COMMAND then begin - Self_.fCurItem := Loword( Msg.wParam ); + Self_.DF.fTBCurItem := Loword( Msg.wParam ); Self_.fCurIndex := Self_.Perform( TB_COMMANDTOINDEX, Loword( Msg.wParam ), 0 ); - Self_.fRightClick := GetKeyState( VK_RBUTTON ) < 0; + {$IFDEF USE_FLAGS} + if GetKeyState( VK_RBUTTON ) < 0 then + include( Self_.fFlagsG6, G6_RightClick ) + else exclude( Self_.fFlagsG6, G6_RightClick ); + {$ELSE} Self_.fRightClick := GetKeyState( VK_RBUTTON ) < 0; {$ENDIF} end else if Msg.message = WM_NOTIFY then begin @@ -35064,12 +35160,12 @@ begin Result := True; idBtn := lpttt.hdr.idFrom; Idx := -1; - if Self_.fTBttCmd <> nil then - Idx := Self_.fTBttCmd.IndexOf( Pointer( idBtn ) ); + if Self_.DF.fTBttCmd <> nil then + Idx := Self_.DF.fTBttCmd.IndexOf( Pointer( idBtn ) ); lpttt.szText[ 0 ] := #0; if Idx >= 0 then {$IFDEF UNICODE_CTRLS} WStrLCopy {$ELSE} StrLCopy {$ENDIF} - ( lpttt.szText, Self_.fTBttTxt.fList.Items[ Idx ], 79 ); + ( lpttt.szText, Self_.DF.fTBttTxt.fList.Items[ Idx ], 79 ); Exit; end; {$IFNDEF _FPC} @@ -35079,12 +35175,12 @@ begin Result := True; idBtn := lpttt.hdr.idFrom; Idx := -1; - if Self_.fTBttCmd <> nil then - Idx := Self_.fTBttCmd.IndexOf( Pointer( idBtn ) ); + if Self_.DF.fTBttCmd <> nil then + Idx := Self_.DF.fTBttCmd.IndexOf( Pointer( idBtn ) ); FillChar( lpttt.szText[ 0 ], 160, #0 ); if Idx >= 0 then begin - WStr := WideString(Self_.fTBttTxt.Items[ Idx ]); + WStr := WideString(Self_.DF.fTBttTxt.Items[ Idx ]); if WStr <> '' then Move( Wstr[ 1 ], lpttt.szText, Min( 158, (Length( WStr ) + 1) * 2 ) ); end; @@ -35095,31 +35191,36 @@ begin NM_RCLICK: begin Mouse := Pointer( Msg.lParam ); - Self_.fCurItem := Mouse.dwItemSpec; + Self_.DF.fTBCurItem := Mouse.dwItemSpec; Self_.fCurIndex := Self_.Perform( TB_COMMANDTOINDEX, Mouse.dwItemSpec, 0 ); - Self_.fRightClick := GetKeyState( VK_RBUTTON ) < 0; - Self_.fRightClick := True; + {$IFDEF USE_FLAGS} include( Self_.fFlagsG6, G6_RightClick ); + {$ELSE} Self_.fRightClick := True; {$ENDIF} end; NM_CLICK: begin - Self_.fCurItem := -1; // return CurItem = -1 + Self_.DF.fTBCurItem := -1; // return CurItem = -1 Self_.fCurIndex := -1; - Self_.fRightClick := False; + {$IFDEF USE_FLAGS} + exclude( Self_.fFlagsG6, G6_RightClick ); + {$ELSE} + Self_.fRightClick := False; + {$ENDIF} Result := Notify.iItem <> -1; // do not handle - if it will be handled in WM_COMMAND Exit; end; TBN_DROPDOWN: begin - Self_.fCurItem := Notify.iItem; - Self_.fCurIndex := Self_.TBItem2Index( Self_.fCurItem ); - if assigned( Self_.fOnDropDown ) then - Self_.fOnDropDown( Self_ ); + Self_.DF.fTBCurItem := Notify.iItem; + Self_.fCurIndex := Self_.TBItem2Index( Self_.DF.fTBCurItem ); + {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnDropDown ) then + {$ENDIF} + Self_.EV.fOnDropDown( Self_ ); end; end; end; end; {$ENDIF ASM_VERSION} -//[END WndProcToolbarCtr] const ToolbarAligns: array[ TControlAlign ] of DWORD = ( CCS_NOPARENTALIGN {or CCS_NOMOVEY} {or CCS_NORESIZE} or CCS_NODIVIDER, CCS_TOP or CCS_VERT, CCS_TOP, CCS_BOTTOM or CCS_VERT, CCS_BOTTOM, @@ -35129,17 +35230,17 @@ const ToolbarAligns: array[ TControlAlign ] of DWORD = 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 ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Toolbar'; + {$ENDIF} end; -//[END NewToolbar] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewToolbar] {$IFDEF ASM_UNICODE} function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarOptions; Bitmap: HBitmap; const Buttons: array of PKOLChar; @@ -35169,7 +35270,11 @@ asm //cmd //opd CALL MakeFlags POP EDX - PUSH 0 + {$IFDEF COMMANDACTIONS_OBJ} + PUSH TOOLBAR_ACTIONS + {$ELSE} + PUSH 0 //: actions : = nil + {$ENDIF} XCHG ECX, EAX // ECX = MakeFlags(...) MOV EDI, ECX MOV EAX, [ESP+8] // EAX = AParent @@ -35178,9 +35283,19 @@ asm //cmd //opd OR ECX, WS_CHILD or WS_VISIBLE or TBSTYLE_TOOLTIPS MOV EDX, offset[ TOOLBARCLASSNAME ] CALL _NewCommonControl + {$IFDEF COMMANDACTIONS_OBJ} + MOV EDX, [EAX].TControl.fCommandActions + MOV [EDX].TCommandActionsObj.aClear, offset[ClearToolbar] + MOV [EDX].TCommandActionsObj.aGetCount, TB_BUTTONCOUNT + {$ELSE} MOV [EAX].TControl.fCommandActions.aClear, offset[ClearToolbar] MOV [EAX].TControl.fCommandActions.aGetCount, TB_BUTTONCOUNT + {$ENDIF} + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG5, 1 shl G5_IsButton + {$ELSE} INC [EAX].TControl.fIsButton + {$ENDIF} POP EDX // pop AParent POP EDX // EDX = Align PUSH EDX @@ -35197,81 +35312,82 @@ asm //cmd //opd @@bounds_ready: PUSH EBX PUSH ESI - XCHG EBX, EAX - MOV ESI, offset[TControl.Perform] - PUSH 0 - PUSH 0 - PUSH TB_GETEXTENDEDSTYLE - PUSH EBX - CALL ESI - OR EAX, TBSTYLE_EX_DRAWDDARROWS - PUSH EAX - PUSH 0 - PUSH TB_SETEXTENDEDSTYLE - PUSH EBX - CALL ESI - MOV EDX, offset[WndProcToolbarCtrl] - MOV EAX, EBX - CALL TControl.AttachProc - MOV EDX, offset[WndProcDoEraseBkgnd] - MOV EAX, EBX - CALL TControl.AttachProc - PUSH 0 - PUSH szTBButton - PUSH TB_BUTTONSTRUCTSIZE - PUSH EBX - CALL ESI - PUSH 0 - PUSH [EBX].TControl.fMargin - PUSH TB_SETINDENT - PUSH EBX - CALL ESI - MOV EAX, [ESP+8] // Align - {$IFDEF PARANOIA} DB $2C, 1 {$ELSE} SUB AL, 1 {$ENDIF} - JL @@bounds_correct - JE @@corr_right - {$IFDEF PARANOIA} DB $2C, 2 {$ELSE} SUB AL, 2 {$ENDIF} - JNE @@corr_bottom -@@corr_right: - MOV EDX, [EBX].TControl.fBoundsRect.Left - ADD EDX, 24 - MOV [EBX].TControl.fBoundsRect.Right, EDX - JMP @@bounds_correct -@@corr_bottom: - MOV EDX, [EBX].TControl.fBoundsRect.Top - ADD EDX, 22 - MOV [EBX].TControl.fBoundsrect.Bottom, EDX -@@bounds_correct: - MOV EDX, [Bitmap] - TEST EDX, EDX - JZ @@bitmap_added - MOV EAX, EBX - CALL TControl.TBAddBitmap -@@bitmap_added: + XCHG EBX, EAX + MOV ESI, offset[TControl.Perform] + PUSH 0 + PUSH 0 + PUSH TB_GETEXTENDEDSTYLE + PUSH EBX + CALL ESI + OR EAX, TBSTYLE_EX_DRAWDDARROWS + PUSH EAX + PUSH 0 + PUSH TB_SETEXTENDEDSTYLE + PUSH EBX + CALL ESI + MOV EDX, offset[WndProcToolbarCtrl] + MOV EAX, EBX + CALL TControl.AttachProc + MOV EDX, offset[WndProcDoEraseBkgnd] + MOV EAX, EBX + CALL TControl.AttachProc + PUSH 0 + PUSH szTBButton + PUSH TB_BUTTONSTRUCTSIZE + PUSH EBX + CALL ESI + PUSH 0 + MOVSX EAX, [EBX].TControl.fMargin + PUSH EAX + PUSH TB_SETINDENT + PUSH EBX + CALL ESI + MOV EAX, [ESP+8] // Align + {$IFDEF PARANOIA} DB $2C, 1 {$ELSE} SUB AL, 1 {$ENDIF} + JL @@bounds_correct + JE @@corr_right + {$IFDEF PARANOIA} DB $2C, 2 {$ELSE} SUB AL, 2 {$ENDIF} + JNE @@corr_bottom + @@corr_right: + MOV EDX, [EBX].TControl.fBoundsRect.Left + ADD EDX, 24 + MOV [EBX].TControl.fBoundsRect.Right, EDX + JMP @@bounds_correct + @@corr_bottom: + MOV EDX, [EBX].TControl.fBoundsRect.Top + ADD EDX, 22 + MOV [EBX].TControl.fBoundsrect.Bottom, EDX + @@bounds_correct: + MOV EDX, [Bitmap] + TEST EDX, EDX + JZ @@bitmap_added + MOV EAX, EBX + CALL TControl.TBAddBitmap + @@bitmap_added: - PUSH dword ptr [BtnImgIdxArray] - PUSH dword ptr [BtnImgIdxArray-4] - MOV ECX, [Buttons-4] - MOV EDX, [Buttons] - MOV EAX, EBX - CALL TControl.TBAddButtons + PUSH dword ptr [BtnImgIdxArray] + PUSH dword ptr [BtnImgIdxArray-4] + MOV ECX, [Buttons-4] + MOV EDX, [Buttons] + MOV EAX, EBX + CALL TControl.TBAddButtons - PUSH 0 - PUSH 0 - PUSH WM_SIZE - PUSH EBX - CALL ESI -// --- -{+|ecm|} -// --- - MOV EDX,EDI - OR EDX,[EBX].TControl.FStyle - MOV EAX,EBX - CALL TControl.SetStyle -// --- -{/+|ecm|} -// --- - XCHG EAX, EBX + PUSH 0 + PUSH 0 + PUSH WM_SIZE + PUSH EBX + CALL ESI + // --- + {+|ecm|} + // --- + MOV EDX,EDI + OR EDX,[EBX].TControl.FStyle + MOV EAX,EBX + CALL TControl.SetStyle + // --- + {/+|ecm|} + // --- + XCHG EAX, EBX POP ESI POP EBX POP EDX @@ -35283,19 +35399,32 @@ function NewToolbar( AParent: PControl; Align: TControlAlign; Options: TToolbarO const BtnImgIdxArray: array of Integer ) : PControl; var Flags: DWORD; begin - if not( tboTextBottom in Options ) then - Options := Options + [ tboTextRight ]; - if tboTextRight in Options then - Options := Options - [ tboTextBottom ]; - Flags := MakeFlags( @Options, ToolbarOptions ); + if Options <> [] then + begin + if not( tboTextBottom in Options ) then + include( Options, tboTextRight ); + if tboTextRight in Options then + exclude( Options, tboTextBottom ); + end; + Flags := MakeFlags( @Options, ToolbarOptions ) + //or TBSTYLE_AUTOSIZE + //or CCS_NOPARENTALIGN or CCS_NOMOVEY //or CCS_NORESIZE + or CCS_NODIVIDER or TBSTYLE_TRANSPARENT + ; DoInitCommonControls( ICC_BAR_CLASSES ); Result := _NewCommonControl( AParent, TOOLBARCLASSNAME, (ToolbarAligns[ Align ] or WS_CHILD or WS_VISIBLE or TBSTYLE_TOOLTIPS or Flags and not (TBSTYLE_FLAT or TBSTYLE_TRANSPARENT)), {!ecm} - tbo3DBorder in Options, nil ); - Result.fCommandActions.aClear := ClearToolbar; + tbo3DBorder in Options, + {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( TOOLBAR_ACTIONS ) + {$ELSE} nil {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:Toolbar'; + {$ENDIF} + Result.fCommandActions.aClear := ClearToolbar; ///+++ anyway +++/// Result.fCommandActions.aGetCount := TB_BUTTONCOUNT; - Result.fIsButton := TRUE; + {$IFDEF USE_FLAGS} include( Result.fFlagsG5, G5_IsButton ); + {$ELSE} Result.fIsButton := TRUE; {$ENDIF} with Result.fBoundsRect do begin if Align in [ caNone ] then @@ -35330,7 +35459,6 @@ begin Result.Style := Result.Style or Flags; {+ecm} end; {$ENDIF ASM_VERSION} -//[END NewToolbar] {$ENDIF USE_CONSTRUCTORS} @@ -35347,21 +35475,29 @@ begin begin NMHdr := Pointer( Msg.lParam ); CASE NMHdr.code OF - DTN_DROPDOWN: if Assigned( Self_.fOnDropDown ) then - Self_.fOnDropDown( Self_ ); - DTN_CLOSEUP: if Assigned( Self_.fOnCloseUp ) then - Self_.fOnCloseUp( Self_ ); + DTN_DROPDOWN:{$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnDropDown ) then + {$ENDIF} + Self_.EV.fOnDropDown( Self_ ); + DTN_CLOSEUP: {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnCloseUp ) then + {$ENDIF} + Self_.EV.fOnCloseUp( Self_ ); DTN_DATETIMECHANGE: - if Assigned( Self_.fOnChange ) then - Self_.fOnChange( Self_ ); + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnChange ) then + {$ENDIF} + Self_.EV.fOnChange( Self_ ); DTN_USERSTRING: - if Assigned( Self_.fOnDTPUserString ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnDTPUserString ) then + {$ENDIF} begin - NMDTString := Pointer( NMHdr ); - D := Self_.DateTime; - AllowChg := TRUE; - Self_.fOnDTPUserString( Self_, KOLString(NMDTString.pszUserString), D, AllowChg ); - NMDTString.dwFlags := Integer( not AllowChg ); + NMDTString := Pointer( NMHdr ); + D := Self_.DateTime; + AllowChg := TRUE; + Self_.EV.fOnDTPUserString( Self_, KOLString(NMDTString.pszUserString), D, AllowChg ); + NMDTString.dwFlags := Integer( not AllowChg ); end; END; end; @@ -35383,7 +35519,11 @@ begin Flags := MakeFlags( @Options, DateTimePickerOptions ); Result := _NewCommonControl( AParent, DATETIMEPICK_CLASS, (WS_CHILD or WS_VISIBLE or WS_TABSTOP or Flags {or DTS_APPCANPARSE}), - TRUE, nil ); + TRUE, {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS ) + {$ELSE} nil {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:DateTimePicker'; + {$ENDIF} Result.SetSize( 110, 24 ); Result.AttachProc( WndProcDateTimePickerNotify ); end; @@ -35488,9 +35628,203 @@ begin Perform( DTM_SETMCCOLOR, Integer( Index ), Color2RGB( Value ) ); end; -procedure TControl.SetDateTimeFormat(const Value: AnsiString); +procedure TControl.SetDateTimeFormat(const Value: KOLString); begin - Perform( DTM_SETFORMAT, 0, Integer( PAnsiChar( Value ) ) ); + Perform( DTM_SETFORMAT, 0, Integer( PKOLChar( Value ) ) ); +end; + +function TControl.GetTBAutoSizeButtons: Boolean; +begin + Result := DF.fDefaultTBBtnStyle and TBSTYLE_AUTOSIZE <> 0; +end; + +function TControl.GetTVEditing: Boolean; +begin + Result := Perform( TVM_GETEDITCONTROL, 0, 0 ) <> 0; +end; + +procedure TControl.SetTBAutoSizeButtons(const Value: Boolean); +begin + DF.fDefaultTBBtnStyle := Integer( Value ) shl 4; +end; + +{$IFDEF USE_FLAGS} +function TControl.GetTabStop: Boolean; +begin + Result := F2_Tabstop in fStyle.f2_Style; +end; + +procedure TControl.SetTabStop(const Value: Boolean); +begin + if Value then include( fStyle.f2_Style, F2_Tabstop ) + else exclude( fStyle.f2_Style, F2_Tabstop ); +end; + +function TControl.GetWordWrap: Boolean; +begin + Result := G1_WordWrap in fFlagsG1; +end; + +procedure TControl.SetWordWrap(const Value: Boolean); +begin + if Value then include( fFlagsG1, G1_WordWrap ) + else exclude( fFlagsG1, G1_WordWrap ); +end; + +function TControl.GetCannotDoubleBuf: Boolean; +begin + Result := G1_CanNotDoublebuf in fFlagsG1; +end; + +procedure TControl.SetCannotDoubleBuf(const Value: Boolean); +begin + if Value then include( fFlagsG1, G1_CanNotDoublebuf ) + else exclude( fFlagsG1, G1_CanNotDoublebuf ); +end; + +function TControl.GetDoubleBuffered: Boolean; +begin + Result := G2_DoubleBuffered in fFlagsG2; +end; + +function TControl.GetTransparent: Boolean; +begin + Result := G2_Transparent in fFlagsG2; +end; + +function TControl.GetIsForm: Boolean; +begin + Result := G3_IsForm in fFlagsG3; +end; + +function TControl.GetSizeGrip: Boolean; +begin + Result := G3_SizeGrip in fFlagsG3; +end; + +procedure TControl.SetSizeGrip(const Value: Boolean); +begin + if Value then include( fFlagsG3, G3_SizeGrip ) + else exclude( fFlagsG3, G3_SizeGrip ); +end; + +function TControl.GetIsApplet: Boolean; +begin + Result := G3_IsApplet in fFlagsG3; +end; + +function TControl.GetIsControl: Boolean; +begin + Result := G3_IsControl in fFlagsG3; +end; + +function TControl.GetIsMDIChild: Boolean; +begin + Result := G3_IsMDIChild in fFlagsG3; +end; + +function TControl.GetCreateVisible: Boolean; +begin + Result := G4_CreateVisible in fFlagsG4; +end; + +procedure TControl.SetCreateVisible(const Value: Boolean); +begin + if Value then include( fFlagsG4, G4_CreateVisible ) + else exclude( fFlagsG4, G4_CreateVisible ); +end; + +function TControl.GetIsButton: Boolean; +begin + Result := G5_IsButton in fFlagsG5; +end; + +function TControl.GetFlat: Boolean; +begin + Result := G3_Flat in fFlagsG3; +end; + +function TControl.GetMouseInCtl: Boolean; +begin + Result := G3_MouseInCtl in fFlagsG3; +end; + +function TControl.GetEraseBackground: Boolean; +begin + Result := G5_EraseBkgnd in fFlagsG5; +end; + +procedure TControl.SetEraseBackground(const Value: Boolean); +begin + if Value then include( fFlagsG5, G5_EraseBkgnd ) + else exclude( fFlagsG5, G5_EraseBkgnd ); +end; + +function TControl.Get3ButtonPress: Boolean; +begin + Result := G5_3ButtonPress in fFlagsG5; +end; + +function TControl.GetKeyPreview: Boolean; +begin + Result := G6_KeyPreview in fFlagsG6; +end; + +procedure TControl.SetKeyPreview(const Value: Boolean); +begin + if Value then include( fFlagsG6, G6_KeyPreview ) + else exclude( fFlagsG6, G6_KeyPreview ); +end; + +function TControl.GetIgnoreDefault: Boolean; +begin + Result := G5_IgnoreDefault in fFlagsG5; +end; + +procedure TControl.SetIgnoreDefault(const Value: Boolean); +begin + if Value then include( fFlagsG5, G5_IgnoreDefault ) + else exclude( fFlagsG5, G5_IgnoreDefault ); +end; + +function TControl.GetWindowed: Boolean; +begin + Result := not(G6_GraphicCtl in fFlagsG6); +end; + +procedure TControl.SetWindowed(const Value: Boolean); +begin + if Value then exclude( fFlagsG6, G6_GraphicCtl ) + else include( fFlagsG6, G6_GraphicCtl ); +end; + +function TControl.Get_RightClick: Boolean; +begin + Result := G6_RightClick in fFlagsG6; +end; + +function TControl.Get_Dragging: Boolean; +begin + Result := G6_Dragging in fFlagsG6; +end; + +function TControl.Get_SizeRedraw: Boolean; +begin + Result := G1_SizeRedraw in fFlagsG1; +end; + +procedure TControl.Set_SizeRedraw(const Value: Boolean); +begin + if Value then include( fFlagsG1, G1_SizeRedraw ) + else exclude( fFlagsG1, G1_SizeRedraw ); +end; + +{$ENDIF USE_FLAGS} + +function TControl.GetDroppedDown: Boolean; +begin + Result := DF.fTBDropped + or (Perform( CB_GetDroppedState, 0, 0 ) <> 0); end; //===================== RichEdit ========================// @@ -35508,13 +35842,13 @@ type PENLink = ^TENLink; lpstrText: PAnsiChar; end; -//[FUNCTION WndProc_RE_LinkNotify] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF not_ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProc_RE_LinkNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Link: PENLink; Range: TextRangeA; Buffer: Array[ 0..1023 ] of AnsiChar; // KOL_ANSI + Buf_W : array[ 0..511 ] of WideChar absolute Buffer; + s: KOLString; begin Result := False; if (Msg.message = WM_NOTIFY) and (PNMHdr( Msg.lParam ).code = EN_LINK) then @@ -35524,26 +35858,45 @@ begin Range.lpstrText := @Buffer[ 0 ]; Buffer[ 0 ] := #0; Self_.Perform( EM_GETTEXTRANGE, 0, Integer( @Range ) ); - if (Buffer[ 1 ] = #0) and (Range.chrg.cpMax - Range.chrg.cpMin > 1) then - Self_.fREUrl := PWideChar( @ Buffer[ 0 ] ) - else - Self_.fREUrl := Buffer; + {$IFDEF UNICODE_CTRLS} + s := Buf_W[0]; //todo: check it! + {$ELSE} + {$IFDEF _D3orHigher} + if (Buffer[ 1 ] = #0) and (Range.chrg.cpMax - Range.chrg.cpMin > 1) then + begin + {$WARNINGS OFF} + s := Buf_W[ 0 ]; + {$WARNINGS ON} + end + else + {$ENDIF} + s := Buffer; + {$ENDIF} + if Self_.DF.fREUrl <> nil then + FreeMem( Self_.DF.fREUrl ); + if s <> '' then + begin + GetMem( Self_.DF.fREUrl, (Length(s)+1) * Sizeof(KOLChar) ); + Move( s[1], Self_.DF.fREUrl^, (Length(s)+1)*Sizeof(KOLChar) ); + end; case Link.msg of WM_MOUSEMOVE: - if assigned( Self_.fOnREOverURL ) then - Self_.fOnREOverURL( Self_ ); + {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnREOverURL ) then + {$ENDIF} + Self_.EV.fOnREOverURL( Self_ ); WM_LBUTTONDOWN, WM_RBUTTONDOWN: - if assigned( Self_.fOnREUrlClick ) then - Self_.fOnREUrlClick( Self_ ); + {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnREUrlClick ) then + {$ENDIF} + Self_.EV.fOnREUrlClick( Self_ ); end; Rslt := 0; Result := TRUE; end; end; {$ENDIF ASM_VERSION} -//[END WndProc_RE_LinkNotify] -//[FUNCTION WndProcRichEditNotify] {$IFDEF ASM_noVERSION} function WndProcRichEditNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; const int_IDC_ARROW = integer( IDC_ARROW ); @@ -35576,19 +35929,21 @@ begin EN_SELCHANGE: begin Self_.DoSelChange; - if Self_.fTransparent then - Self_.Invalidate; + if {$IFDEF USE_FLAGS} G2_Transparent in Self_.fFlagsG2 + {$ELSE} Self_.fTransparent {$ENDIF} then + Self_.Invalidate; end; end; end else if Msg.message = WM_DESTROY then begin - Self_.fREURL := ''; + if Self_.DF.fREUrl <> nil then + FreeMem( Self_.DF.fREUrl ); + Self_.DF.fREURL := nil; end; end; {$ENDIF ASM_VERSION} -//[END WndProcRichEditNotify] const RichEditflags: array [ TEditOption ] of Integer = ( not (es_AutoHScroll or WS_HSCROLL), @@ -35603,16 +35958,16 @@ const RichEditflags: array [ TEditOption ] of Integer = ( es_WantReturn, 0, es_Number ); {$IFDEF USE_CONSTRUCTORS} -//[function NewRichEdit1] function NewRichEdit1( AParent: PControl; Options: TEditOptions ): PControl; begin new( Result, CreateRichEdit1( AParent, Options ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:RichEdit'; + {$ENDIF} end; -//[END NewRichEdit1] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewRichEdit1] -{$IFDEF ASM_UNICODE} +{$IFDEF noASM_UNICODE} function NewRichEdit1( AParent: PControl; Options: TEditOptions ): PControl; const RichNamesCount = High( RichEditLibnames ) + 1; @@ -35674,11 +36029,19 @@ asm POP EDX POP EAX PUSH 1 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [RichEditActions_Packed] + {$ELSE} PUSH offset[RichEditActions] + {$ENDIF} MOV EDX, [RichEditClass] OR ECX, WS_VISIBLE or WS_CHILD or WS_TABSTOP or WS_BORDER or ES_MULTILINE CALL _NewCommonControl + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG5, 1 shl G5_IgnoreDefault + {$ELSE} INC [EAX].TControl.fIgnoreDefault + {$ENDIF} POP EDX TEST DH, 4 // is eoWantTab in Options ? SETZ DL @@ -35687,8 +36050,13 @@ asm MOV EBX, EAX MOV EDX, offset[WndProcRichEditNotify] CALL TControl.AttachProc - MOV [EBX].TControl.fDoubleBuffered, 0 + {$IFDEF USE_FLAGS} + OR [EBX].TControl.fFlagsG1, (1 shl G1_CanNotDoublebuf) + AND [EBX].TControl.fFlagsG2, not (1 shl G2_DoubleBuffered) + {$ELSE} INC [EBX].TControl.fCannotDoubleBuf + MOV [EBX].TControl.fDoubleBuffered, 0 + {$ENDIF USE_FLAGS} ADD [EBX].TControl.fBoundsRect.Right, 100-64 ADD [EBX].TControl.fBoundsRect.Bottom, 200-64 PUSH ENM_CHANGE or ENM_SELCHANGE or ENM_REQUESTRESIZE or ENM_PROTECTED or $04000000 @@ -35721,29 +36089,29 @@ begin Log( '->NewRichEdit1' ); TRY {$ENDIF INPACKAGE} - if FRichEditModule = 0 then + if FRichEditModule = 0 then begin search_richedit: - I := RichEditIdx; - Last := High( RichEditLibnames ); - d := 1; - if RichEditIdx > 1 then // 50W, 20A - begin - I := Last; - Last := 0; - d := -1; - end; - SaveErrMode := SetErrorMode( SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS ); - while I <> Last + d do - begin - FRichEditModule := LoadLibrary( RichEditLibnames[ I ] ); - RichEditClass := RichEditClasses[ I ]; - if FRichEditModule > HINSTANCE_ERROR then break; - inc( I, d ); - end; - if FRichEditModule <= HINSTANCE_ERROR then - FRichEditModule := 0; - SetErrorMode( SaveErrMode ); + I := RichEditIdx; + Last := High( RichEditLibnames ); + d := 1; + if RichEditIdx > 1 then // 50W, 20A + begin + I := Last; + Last := 0; + d := -1; + end; + SaveErrMode := SetErrorMode( SEM_NOOPENFILEERRORBOX or SEM_FAILCRITICALERRORS ); + while I <> Last + d do + begin + FRichEditModule := LoadLibrary( RichEditLibnames[ I ] ); + RichEditClass := RichEditClasses[ I ]; + if FRichEditModule > HINSTANCE_ERROR then break; + inc( I, d ); + end; + if FRichEditModule <= HINSTANCE_ERROR then + FRichEditModule := 0; + SetErrorMode( SaveErrMode ); end; Flags := MakeFlags( @Options, RichEditFlags ); {$IFDEF INPACKAGE} @@ -35751,18 +36119,33 @@ begin {$ENDIF INPACKAGE} Result := _NewCommonControl( AParent, RichEditClass, WS_VISIBLE or WS_CHILD or WS_TABSTOP or WS_BORDER or ES_MULTILINE or Flags, - True, @RichEditActions ); + True, {$IFDEF PACK_COMMANDACTIONS} RichEditActions_Packed + {$ELSE} @RichEditActions {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:RichEdit'; + {$ENDIF} + {$IFDEF STATIC_RICHEDIT_DATA}{$ELSE} + Result.DF.fRECharFormatRec := AllocMem( Sizeof( TCharFormat ) + Sizeof( TParaFormat2 ) ); + Result.DF.fREParaFmtRec := Pointer( Integer( @ Result.DF.fRECharFormatRec ) + + Sizeof( TCharFormat ) ); + Result.Add2AutoFreeEx( Result.FreeCharFormatRec ); + {$ENDIF} {$IFDEF INPACKAGE} Log( '//// after _NewCommonControl called' ); {$ENDIF INPACKAGE} - Result.fIgnoreDefault := TRUE; Result.fLookTabKeys := [ tkTab ]; if eoWantTab in Options then Result.fLookTabKeys := [ ]; Result.AttachProc( WndProcRichEditNotify ); - Result.fDoubleBuffered := False; - Result.fCannotDoubleBuf := True; + {$IFDEF USE_FLAGS} + include( Result.fFlagsG1, G1_CanNotDoublebuf ); + exclude( Result.fFlagsG2, G2_DoubleBuffered ); + include( Result.fFlagsG5, G5_IgnoreDefault ); + {$ELSE} Result.fCannotDoubleBuf := True; + Result.fDoubleBuffered := False; + Result.fIgnoreDefault := TRUE; + {$ENDIF} with Result.fBoundsRect do begin Right := Right + 100; @@ -35790,20 +36173,16 @@ begin {$ENDIF INPACKAGE} end; {$ENDIF ASM_VERSION} -//[END NewRichEdit1] {$ENDIF NOT_USE_RICHEDIT} {$ENDIF USE_CONSTRUCTORS} -//[API OleInitialize] function OleInitialize(pwReserved: Pointer): HResult; stdcall; external 'ole32.dll' name 'OleInitialize'; procedure OleUninitialize; stdcall; external 'ole32.dll' name 'OleUninitialize'; -//[FUNCTION OleInit] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function OleInit: Boolean; begin if OleInitCount = 0 then @@ -35815,11 +36194,8 @@ begin Result := True; end; {$ENDIF ASM_VERSION} -//[END OleInit] -//[PROCEDURE OleUnInit] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure OleUnInit; begin if OleInitCount > 0 then @@ -35830,16 +36206,12 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END OleUnInit] -//[API SysAllocStringLen] function SysAllocStringLen; external 'oleaut32.dll' name 'SysAllocStringLen'; procedure SysFreeString( psz: PWideChar ); stdcall; external 'oleaut32.dll' name 'SysFreeString'; -{-} -//[function StringToOleStr] function StringToOleStr(const Source: Ansistring): PWideChar; var SourceLen, ResultLen: Integer; @@ -35858,19 +36230,18 @@ begin Result, ResultLen); end; end; -{+} {$IFNDEF NOT_USE_RICHEDIT} {$IFDEF USE_CONSTRUCTORS} -//[function NewRichEdit] function NewRichEdit( AParent: PControl; Options: TEditOptions ): PControl; begin new( Result, CreateRichEdit( AParent, Options ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:RichEdit'; + {$ENDIF} end; -//[END NewRichEdit] {$ELSE not_USE_CONSTRUCTORS} -//[FUNCTION NewRichEdit] {$IFDEF ASM_VERSION} const RichEdit50W: array[0..11] of AnsiChar = ('R','i','c','h','E','d','i','t','5','0','W',#0 ); function NewRichEdit( AParent: PControl; Options: TEditOptions ): PControl; @@ -35884,8 +36255,8 @@ asm JZ @@new1 MOV [RichEditIdx], 0 CALL NewRichEdit1 - MOV byte ptr [EAX].TControl.fCharFmtDeltaSz, deltaChr - MOV byte ptr [EAX].TControl.fParaFmtDeltaSz, deltaPar + MOV byte ptr [EAX].TControl.DF.fCharFmtDeltaSz, deltaChr + MOV byte ptr [EAX].TControl.DF.fParaFmtDeltaSz, deltaPar RET @@new1: CALL NewRichEdit1 end; @@ -35907,9 +36278,9 @@ begin RichEditIdx := 0; // Richedit20A / RichEdit {$ENDIF} Result := NewRichEdit1( AParent, Options ); - Result.fCharFmtDeltaSz := 24; //sizeof( TCharFormat2 ) - sizeof( RichEdit.TCharFormat ); + Result.DF.fCharFmtDeltaSz := 24; //sizeof( TCharFormat2 ) - sizeof( RichEdit.TCharFormat ); // sizeof( TCharFormat2 ) is calculated incorrectly - Result.fParaFmtDeltaSz := sizeof( TParaFormat2 ) - sizeof( RichEdit.TParaFormat ); + Result.DF.fParaFmtDeltaSz := sizeof( TParaFormat2 ) - sizeof( RichEdit.TParaFormat ); end else begin @@ -35926,7 +36297,6 @@ begin {$ENDIF INPACKAGE} end; {$ENDIF ASM_VERSION} -//[END NewRichEdit] {$ENDIF USE_CONSTRUCTORS} {$ENDIF NOT_USE_RICHEDIT} @@ -35936,54 +36306,74 @@ end; { TControl } -//[procedure TControl.Init] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.Init; +{$IFNDEF OLD_EVENTS_MODEL} +var i: Integer; +{$ENDIF} begin - {$IFDEF _D2orD3} + {$IFDEF CALL_INHERITED} inherited; // nothing here for Delphi 4 and higher {$ENDIF} - {$IFDEF USE_GRAPHCTLS} - fDoInvalidate := InvalidateWindowed; - {$ENDIF} {$IFDEF GDI} - fOnDynHandlers := WndProcDummy; - fWndProcKeybd := WndProcDummy; - fWndProcResizeFlicks := WndProcDummy; - fPass2DefProc := WndProcDummy; - fWndFunc := @ WndFunc; - fCommandActions.aClear := ClearText; - fWindowed := True; - fControlClick := DummyObjProc; - fAutoSize := DummyObjProc; + {$IFDEF OLD_EVENTS_MODEL} + {$IFDEF USE_GRAPHCTLS} + PP.fDoInvalidate := InvalidateWindowed; + {$ENDIF} + PP.fOnDynHandlers := WndProcDummy; + PP.fWndProcKeybd := WndProcDummy; + //{-2.95}PP.fWndProcResizeFlicks := WndProcDummy; + PP.fPass2DefProc := WndProcDummy; + PP.fControlClick := DummyObjProc; + PP.fAutoSize := DummyObjProc; + PP.fWndFunc := @ WndFunc; + {$ELSE} + {$IFDEF EVENTS_DYNAMIC} + if not Assigned( EmptyEvents.fOnMessage ) then + for i := 0 to idx_LastEvent do + EmptyEvents.MethodEvents[i].Code := DummyProcTable[InitEventsTable[i] and $F]; + EV := @ EmptyEvents; + for i := 0 to High(PP.Procedures) do + PP.Procedures[i] := DummyProcTable[InitEventsTable[i] shr 4]; + {$ELSE} + for i := 0 to idx_LastEvent do + begin + EV.MethodEvents[i].Code := DummyProcTable[InitEventsTable[i] and $F]; + //EV.MethodEvents[i].Data := @Self; + if i < idx_LastProc - idx_LastEvent then + PP.Procedures[i] := DummyProcTable[InitEventsTable[i] shr 4]; + end; + {$ENDIF} + {$ENDIF NEW_EVENTS_MODEL} + fAlphaBlend := 255; + //---- fCommandActions.aClear := ClearText; //--- moved to _NewWindowed fColor := clBtnFace; fTextColor := clWindowText; {$ENDIF GDI} fMargin := 2; {$IFDEF GDI} - fCtl3D := True; - fCtl3Dchild := True; - fAlphaBlend := 255; + //fCtl3D := True; fCtl3Dchild := True; + fCtl3D_child := 3; {$ENDIF GDI} fChildren := NewList; {$IFDEF GDI} fClsStyle := CS_OWNDC; - fStyle := WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or + fStyle.Value := WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_BORDER or WS_THICKFRAME; fExStyle := WS_EX_CONTROLPARENT; {$ENDIF GDI} - fVisible := True; - fEnabled := True; + {$IFDEF USE_FLAGS} + {$ELSE} fWindowed := True; + fVisible := True; + fEnabled := True; + {$ENDIF} fDynHandlers := NewList; end; {$ENDIF ASM_VERSION} -//[PROCEDURE CallTControlInit] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.InitParented( AParent: PControl ); begin Init; @@ -35995,39 +36385,37 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TControl.InitParented( AParent: PControl; widget: PGtkWidget; +PROCEDURE TControl.InitParented( AParent: PControl; widget: PGtkWidget; need_eventbox: Boolean ); -begin +BEGIN Init; fHandle := widget; fCaptionHandle := fHandle; fEventboxHandle := fHandle; - if need_eventbox then - begin - fEventboxHandle := gtk_event_box_new(); - gtk_widget_set_events( fEventboxHandle, GDK_ALL_EVENTS_MASK ); - //gtk_container_add( GTK_CONTAINER( AParent.fHandle ), fEventboxHandle ); - gtk_widget_show( fEventboxHandle ); - gtk_container_add( GTK_CONTAINER( fEventboxHandle ), fHandle ); - end; + IF need_eventbox THEN + BEGIN + fEventboxHandle := gtk_event_box_new(); + gtk_widget_set_events( fEventboxHandle, GDK_ALL_EVENTS_MASK ); + //gtk_container_add( GTK_CONTAINER( AParent.fHandle ), fEventboxHandle ); + gtk_widget_show( fEventboxHandle ); + gtk_container_add( GTK_CONTAINER( fEventboxHandle ), fHandle ); + END; g_object_set_data( G_OBJECT( fEventboxHandle ), ID_SELF, @ Self ); if AParent <> nil then fColor := AParent.fColor; Parent := AParent; -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -procedure TControl.InitOrthaned( AParentWnd: HWnd ); +procedure TControl.InitOrthaned( AParentWnd: HWnd ); begin Init; FParentWnd := AParentWnd; end; -//[destructor TControl.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TControl.Destroy; var I: Integer; F: PControl; @@ -36054,10 +36442,10 @@ begin F := ParentForm; // or Applet - for form ??? {$ENDIF} if F <> nil then - if F.FCurrentControl = @Self then - F.FCurrentControl := nil; + if F.DF.FCurrentControl = @Self then + F.DF.FCurrentControl := nil; - if FHandle <> 0 then + if fHandle <> 0 then ShowWindow( fHandle, SW_HIDE ); Final; @@ -36066,106 +36454,114 @@ begin DestroyChildren; {$ENDIF} - if not fDestroying then + if {$IFDEF USE_FLAGS} not(G2_Destroying in fFlagsG2) + {$ELSE} not fDestroying {$ENDIF} then begin - fDestroying := True; + {$IFDEF USE_FLAGS} include( fFlagsG2, G2_Destroying ); + {$ELSE} fDestroying := True; {$ENDIF} - if fCtlClsNameChg then - begin - FreeMem( fControlClassName ); - fCtlClsNameChg := FALSE; - end; - - {$IFDEF USE_AUTOFREE4CONTROLS} - {$ELSE} - fFont.Free; - fFont := nil; - fBrush.Free; - fBrush := nil; - {$ENDIF} - fCanvas.Free; - fCanvas := nil; - - if fHandle <> 0 then - begin - {$IFNDEF NEW_MENU_ACCELL} - {$IFDEF USE_AUTOFREE4CONTROLS} - {$ELSE} - if fAccelTable <> 0 then + if {$IFDEF USE_FLAGS} G6_CtlClassNameChg in fFlagsG6 + {$ELSE} fCtlClsNameChg {$ENDIF} then begin - DestroyAcceleratorTable( fAccelTable ); - fAccelTable := 0; + FreeMem( fControlClassName ); + {$IFDEF USE_FLAGS} exclude( fFlagsG6, G6_CtlClassNameChg ); + {$ELSE} fCtlClsNameChg := FALSE; {$ENDIF} end; - {$ENDIF} - {$ENDIF} + {$IFDEF USE_AUTOFREE4CONTROLS} {$ELSE} - fMenuObj.Free; - while fImageList <> nil do - fImageList.Free; + fFont.Free; + fFont := nil; + fBrush.Free; + fBrush := nil; {$ENDIF} - I := fHandle; - Ico := fIcon; - if (Ico <> 0) and (Ico <> HIcon(-1)) then - if not fIconShared then - DestroyIcon( Ico ); - if IsWindow( I ) then + fCanvas.Free; + fCanvas := nil; + + if fHandle <> 0 then begin -// RemoveProp( I, ID_SELF ); //************** Remarked By M.Gerasimov - if not fNCDestroyed then + {$IFNDEF NEW_MENU_ACCELL} + {$IFDEF USE_AUTOFREE4CONTROLS} + {$ELSE} + if fAccelTable <> 0 then begin - {$IFDEF DEBUG_ENDSESSION} - if EndSession_Initiated then - LogFileOutput( GetStartDir + 'es_debug.txt', - 'DESTROYING HWND:' + Int2Str( I ) ); - {$ENDIF} - //if fIsForm then - {$IFDEF USE_PROP} - SetProp( I, ID_SELF, 0 ); - {$ELSE} - SetWindowLong( I, GWL_USERDATA, 0 ); - {$ENDIF} - DestroyWindow( I ); + DestroyAcceleratorTable( fAccelTable ); + fAccelTable := 0; end; + {$ENDIF} + {$ENDIF} + {$IFDEF USE_AUTOFREE4CONTROLS} + {$ELSE} + fMenuObj.Free; + while fImageList <> nil do + fImageList.Free; + {$ENDIF} + I := fHandle; + Ico := DF.fIcon; + if (Ico <> 0) and (Ico <> HIcon(-1)) then + if {$IFDEF USE_FLAGS} not(G1_IconShared in fFlagsG1) + {$ELSE} not fIconShared {$ENDIF} then + DestroyIcon( Ico ); + if IsWindow( I ) then + begin + // RemoveProp( I, ID_SELF ); //************** Remarked By M.Gerasimov + {$IFDEF USE_fNCDestroyed} + if not fNCDestroyed then + {$ENDIF} + begin + {$IFDEF DEBUG_ENDSESSION} + if EndSession_Initiated then + LogFileOutput( GetStartDir + 'es_debug.txt', + 'DESTROYING HWND:' + Int2Str( I ) ); + {$ENDIF} + {$IFnDEF SMALLER_CODE} + {$IFDEF USE_PROP} + SetProp( I, ID_SELF, 0 ); + {$ELSE} + SetWindowLong( I, GWL_USERDATA, 0 ); + {$ENDIF} + {$ENDIF} + DestroyWindow( I ); + end; + end; + fHandle := 0; end; - fHandle := 0; - end; - if fCustomData <> nil then - FreeMem( fCustomData ); - fCustomData := nil; - fCustomObj.Free; - fCustomObj := nil; + if fCustomData <> nil then + FreeMem( fCustomData ); + fCustomData := nil; + fCustomObj.Free; + fCustomObj := nil; - if fTmpBrush <> 0 then - DeleteObject( fTmpBrush ); - fTmpBrush := 0; + if fTmpBrush <> 0 then + DeleteObject( fTmpBrush ); + fTmpBrush := 0; - //if FCaption <> nil then FreeMem( FCaption ); - fCaption := ''; - if fStatusTxt <> nil then - FreeMem( fStatusTxt ); + //if FCaption <> nil then FreeMem( FCaption ); + fCaption := ''; + //if fStatusTxt <> nil then + // FreeMem( fStatusTxt ); - if fParent <> nil then - begin - fParent.fChildren.Remove( @Self ); - {$IFDEF USE_AUTOFREE4CHILDREN} - fParent.RemoveFromAutoFree( @ Self ); - {$ENDIF} - if fParent.fCurrentControl = @Self then - fParent.fCurrentControl := nil; - end; + if fParent <> nil then + begin + fParent.fChildren.Remove( @Self ); + {$IFDEF USE_AUTOFREE4CHILDREN} + fParent.RemoveFromAutoFree( @ Self ); + {$ENDIF} + if fParent.DF.fCurrentControl = @Self then + fParent.DF.fCurrentControl := nil; + end; - fChildren.Free; - {$IFDEF USE_AUTOFREE4CONTROLS} - {$ELSE} - fTBttCmd.Free; - fTBttTxt.Free; - fTmpFont.Free; - {$ENDIF} - fDynHandlers.Free; - //fREUrl := ''; - inherited; + fChildren.Free; + {$IFDEF USE_AUTOFREE4CONTROLS} + {$ELSE} + DF.fTBttCmd.Free; + DF.fTBttTxt.Free; + fTmpFont.Free; + {$ENDIF} + fDynHandlers.Free; + //fREUrl := ''; + inherited; end; end; {$ENDIF ASM_VERSION} @@ -36176,24 +36572,29 @@ end; {$UNDEF code} {$ENDIF} -//[procedure TControl.SetEnabled] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetEnabled( Value: Boolean ); begin if GetEnabled = Value then Exit; + {$IFDEF USE_FLAGS} + {$ELSE} fEnabled := Value; - if Value then - fStyle := fStyle and not WS_DISABLED - else - fStyle := fStyle or WS_DISABLED; - if fHandle <> 0 then - EnableWindow( fHandle, fEnabled ); + {$ENDIF USE_FLAGS} + if Value then + exclude( fStyle.f3_Style, F3_Disabled ) + else include( fStyle.f3_Style, F3_Disabled ); + if fHandle <> 0 then + begin + {$IFDEF USE_FLAGS} + EnableWindow( fHandle, not(F3_Disabled in fStyle.f3_Style)); + {$ELSE} + EnableWindow( fHandle, fEnabled ); + {$ENDIF} + end; Invalidate; // necessary for Graphic controls end; {$ENDIF ASM_VERSION} -//[function TControl.GetParentWindow] {$IFDEF ASM_noVERSION} {$ELSE ASM_VERSION} //Pascal function TControl.GetParentWindow: HWnd; @@ -36224,7 +36625,11 @@ asm @@1: PUSH EBX MOV EBX, EAX + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG4, 1 shl G4_CreateVisible + {$ELSE} CMP [EBX].fCreateVisible, 0 + {$ENDIF} JNZ @@2 XOR EDX, EDX @@ -36235,7 +36640,11 @@ asm { This is a call to Pascal piece of code, which calls virtual method TControl.CreateWindow } + {$IFDEF USE_FLAGS} + OR [EBX].fFlagsG4, 1 shl G4_CreateHidden + {$ELSE} INC [EBX].fCreateHidden + {$ENDIF} JMP @@0 @@2: CALL CallTControlCreateWindow @@ -36251,14 +36660,15 @@ begin {$ENDIF INPACKAGE} if fHandle = 0 then begin - if not fCreateVisible then + if {$IFDEF USE_FLAGS} not(G4_CreateVisible in fFlagsG4) + {$ELSE} not fCreateVisible {$ENDIF} then begin - Set_Visible( False ); - CreateWindow; //virtual!!! - fCreateHidden := True; - end - else - CreateWindow; //virtual!!! + Set_Visible( False ); + CreateWindow; //virtual!!! + {$IFDEF USE_FLAGS} include( fFlagsG4, G4_CreateHidden ); + {$ELSE} fCreateHidden := True; {$ENDIF} + end else + CreateWindow; //virtual!!! end; Result := fHandle; {$IFDEF INPACKAGE} @@ -36269,22 +36679,6 @@ begin {$ENDIF INPACKAGE} end; {$ENDIF ASM_VERSION} -{-} - -{$IFDEF _D7orHigher} -// may be it was a good idea to replace CreateWindowEx, -// but Inprise forget about stdcall... In result, asm-version became broken. -//[API CreateWindowEx] -{$IFNDEF UNICODE_CTRLS} -(*{$IFNDEF _D2009orHigher} // D12 Mark -function CreateWindowEx(dwExStyle: DWORD; lpClassName: PAnsiChar; - lpWindowName: PAnsiChar; dwStyle: DWORD; X, Y, nWidth, nHeight: Integer; - hWndParent: HWND; hMenu: HMENU; hInstance: HINST; lpParam: Pointer): HWND; - stdcall; external user32 name 'CreateWindowExA'; -{$ENDIF}*) -// already in KOL_ANSI.inc -{$ENDIF} -{$ENDIF} {$IFDEF DEBUG_CREATEWINDOW} procedure Debug_CreateWindow1( _Self: PControl ); @@ -36326,10 +36720,9 @@ begin end; {$ENDIF DEBUG_CREATEWINDOW} -{+} -//[function TControl.CreateWindow] {$IFDEF ASM_UNICODE} function TControl.CreateWindow: Boolean; +type PCreateWndParams = ^TCreateWndParams; const CS_OFF = CS_OWNDC or CS_CLASSDC or CS_PARENTDC or CS_GLOBALCLASS; CS_ON = 0; //CS_VREDRAW or CS_HREDRAW; @@ -36351,15 +36744,23 @@ asm @@chk_handle: MOV ECX, [EBX].fHandle JECXZ @@prepare_Params - MOV DL, 0 MOV EAX, EBX - CMP [EBX].fCreateHidden, DL + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG4, 1 shl G4_CreateHidden + {$ELSE} + //MOV DL, 0 + CMP [EBX].fCreateHidden, 0 + {$ENDIF} JZ @@create_children CALL CreateChildWindows MOV EAX, EBX MOV DL, 1 CALL Set_Visible + {$IFDEF USE_FLAGS} + AND [EBX].fFlagsG4, not(1 shl G4_CreateHidden) + {$ELSE} MOV [EBX].fCreateHidden, 0 + {$ENDIF} JMP @@ret_true @@create_children: CALL CreateChildWindows @@ -36370,9 +36771,15 @@ asm RET @@prepare_params: {$IFDEF USE_GRAPHCTLS} - MOV AL, [EBX].fWindowed - CMP AL, 0 - JZ @@ret_0 + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG6, 1 shl G6_GraphicCtl + SETNZ AL + JNZ @@ret_0 + {$ELSE} + MOV AL, [EBX].fWindowed + CMP AL, 0 + JZ @@ret_0 + {$ENDIF} {$ENDIF} PUSH EBP MOV EBP, ESP @@ -36389,7 +36796,11 @@ asm PUSH [hInstance]// Params.WindowClass.hInstance := hInstance PUSH ECX // Params.WindowClass.cbWndExtra := 0 PUSH ECX // Params.WindowClass.cbClsExtra := 0 + {$IFDEF SAFE_CODE} PUSH [EBX].fDefWndProc // Params.WindowClass.lpfnWndProc := fDefWndProc + {$ELSE} + PUSH 0 + {$ENDIF} PUSH [EBX].fClsStyle // Params.WindowClass.style := fStyle ADD ESP, -64 PUSH ECX @@ -36423,14 +36834,22 @@ asm CMOVZ EAX, ECX {$ELSE} JNZ @@2 - MOV EAX, ECX + XCHG EAX, ECX @@2: {$ENDIF} PUSH EAX // Params.Width := Width | CW_UseDefault MOV EAX, [EBX].fBoundsRect.Left + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG3, 1 shl G3_IsControl + {$ELSE} CMP [EBX].fIsControl, CL + {$ENDIF} JNZ @@3 + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG2, (1 shl G2_ChangedPos) or (1 shl G2_ChangedSize) + {$ELSE} TEST byte ptr [EBX].fChangedPosSz, 3 + {$ENDIF USE_FLAGS} JNZ @@3 MOV EDX, ECX XCHG EAX, ECX @@ -36459,8 +36878,8 @@ asm MOV [EBX].fDefWndProc, EAX @@fDefWndProc_ready: MOV ECX, [ESP].TCreateWndParams.WndParent - INC ECX - LOOP @@registerClass1 + TEST ECX, ECX + JNZ @@registerClass1 TEST byte ptr [ESP].TCreateWndParams.Style+3, $40 XCHG EAX, ECX JNZ @@fin @@ -36531,7 +36950,11 @@ asm @@propSet: {$IFDEF SMALLEST_CODE} {$ELSE} + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG3, 1 shl G3_IsControl + {$ELSE} CMP [EBX].fIsControl, 0 + {$ENDIF} JNZ @@iconSet MOV EAX, EBX CALL GetIcon @@ -36542,16 +36965,19 @@ asm CALL Perform @@iconSet: {$ENDIF} - MOV ECX, [EBX].fCreateWndExt + MOV ECX, [EBX].PP.fCreateWndExt + {$IFDEF NIL_EVENTS} JECXZ @@dblbufcreate + {$ENDIF} MOV EAX, EBX CALL ECX @@dblbufcreate: @@applyfont: MOV EAX, EBX - CALL ApplyFont2Wnd + CALL [ApplyFont2Wnd_Proc] MOV EAX, EBX - CALL ApplyFont2Wnd + CALL [ApplyFont2Wnd_Proc] +@@createchildren: XCHG EAX, EBX CALL CreateChildWindows MOV AL, 1 @@ -36589,15 +37015,16 @@ begin Exit; if fHandle <> 0 then begin - if fCreateHidden then + if {$IFDEF USE_FLAGS} G4_CreateHidden in fFlagsG4 + {$ELSE} fCreateHidden {$ENDIF} then begin - CreateChildWindows; - Set_Visible( True ); - fCreateHidden := False; - end - else + CreateChildWindows; + Set_Visible( True ); + {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_CreateHidden ); + {$ELSE} fCreateHidden := False; {$ENDIF} + end else begin - CreateChildWindows; + CreateChildWindows; end; Result := True; {$IFDEF INPACKAGE} @@ -36607,7 +37034,8 @@ begin end; {$IFDEF USE_GRAPHCTLS} - if not fWindowed then Exit; + if {$IFDEF USE_FLAGS} (G6_GraphicCtl in fFlagsG6) + {$ELSE} not fWindowed {$ENDIF} then Exit; {$ENDIF} {$IFDEF INPACKAGE} @@ -36619,7 +37047,7 @@ begin Params.WindowClass.hInstance := hInstance; Params.WindowClass.lpfnWndProc := fDefWndProc; Params.WindowClass.style := fClsStyle; - {$IFDEF _FPC} + {$IFDEF _FPC} SClassName := SubClassName; StrCopy( Params.WinClsNamBuf, @ SClassName[ 1 ] ); {$ELSE} @@ -36636,19 +37064,22 @@ begin Params.Menu := fMenu; Params.WndParent := GetParentWnd( TRUE ); Params.Height := fBoundsRect.Bottom - fBoundsRect.Top; - if Params.Height = 0 then - Params.Height := CW_UseDefault; + if Params.Height = 0 then + Params.Height := CW_UseDefault; Params.Width := fBoundsRect.Right - fBoundsRect.Left; - if Params.Width = 0 then - Params.Width := CW_UseDefault; + if Params.Width = 0 then + Params.Width := CW_UseDefault; Params.Y := fBoundsRect.Top; Params.X := fBoundsRect.Left; - if not fIsControl and (fChangedPosSz and 3 = 0) then + if {$IFDEF USE_FLAGS} not(G3_IsControl in fFlagsG3) + {$ELSE} not fIsControl {$ENDIF} + and {$IFDEF USE_FLAGS} not(G2_ChangedPos in fFlagsG2) + {$ELSE} (fChangedPosSz and 3 = 0) {$ENDIF} then begin Params.Y := CW_UseDefault; Params.X := CW_UseDefault; end; - Params.Style := fStyle; + Params.Style := fStyle.Value; Params.Caption := PKOLChar( fCaption ); Params.WinClassName := @ Params.WinClsNamBuf[ 0 ]; Params.ExStyle := fExStyle; @@ -36744,16 +37175,20 @@ begin {$ENDIF INPACKAGE} {$IFDEF SMALLEST_CODE} {$ELSE} - if not fIsControl then - Perform( WM_SETICON, 1 {ICON_BIG}, GetIcon ); + if {$IFDEF USE_FLAGS} not(G3_IsControl in fFlagsG3) + {$ELSE} not fIsControl {$ENDIF} then + Perform( WM_SETICON, 1 {ICON_BIG}, GetIcon ); {$ENDIF} - if Assigned( FCreateWndExt ) then - FCreateWndExt( @Self ); + {$IFDEF NIL_EVENTS} + if Assigned( PP.FCreateWndExt ) then + {$ENDIF} + PP.FCreateWndExt( @Self ); {$IFDEF INPACKAGE} Log( '/// ApplyFont2Wnd' ); {$ENDIF INPACKAGE} - ApplyFont2Wnd; - ApplyFont2Wnd; + + ApplyFont2Wnd_Proc( @Self ); + ApplyFont2Wnd_Proc( @Self ); {$IFDEF INPACKAGE} Log( '/// CreateChildWindows' ); @@ -36778,28 +37213,31 @@ end; {$IFDEF _X_} {$IFDEF GTK} -procedure TControl.VisualizyWindow; -var i: Integer; +PROCEDURE TControl.VisualizyWindow; +VAR i: Integer; C: PControl; -begin - if fHandle = nil then Exit; - if not fIsApplet and FVisible then - begin - for i := 0 to ChildCount-1 do - begin - C := Children[ i ]; - if C.fVisible then - C.VisualizyWindow; - end; - gtk_widget_show( fHandle ); - end; -end; +BEGIN + IF fHandle = nil THEN Exit; + IF {$IFDEF USE_FLAGS} not(G3_IsApplet in fFlagsG3) + {$ELSE} not fIsApplet {$ENDIF} + AND {$IFDEF USE_FLAGS} (F3_Visible in fStyle.f3_Style) + {$ELSE} FVisible {$ENDIF} then + BEGIN + FOR i := 0 to ChildCount-1 do + BEGIN + C := Children[ i ]; + if {$IFDEF USE_FLAGS} F3_Visible in fStyle.f3_Style + {$ELSE} C.fVisible {$ENDIF} then + C.VisualizyWindow; + END; + gtk_widget_show( fHandle ); + END; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} //- -//[procedure TControl.CreateSubclass] procedure TControl.CreateSubclass(var Params: TCreateParams; ControlClassName: PKOLChar); const @@ -36828,9 +37266,7 @@ begin end; end; -//[FUNCTION WndProcMouse] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProcMouse(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; var MouseData: TMouseEventData; begin @@ -36853,65 +37289,87 @@ begin Rslt := 0; // needed ? case Msg.message of WM_LBUTTONDOWN: - if Assigned( Self_.OnMouseDown ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseDown ) then + {$ENDIF} begin Button := mbLeft; - Self_.OnMouseDown( Self_, MouseData ); + Self_.EV.fOnMouseDown( Self_, MouseData ); end; WM_RBUTTONDOWN: - if Assigned( Self_.OnMouseDown ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseDown ) then + {$ENDIF} begin Button := mbRight; - Self_.OnMouseDown( Self_, MouseData ); + Self_.EV.fOnMouseDown( Self_, MouseData ); end; WM_MBUTTONDOWN: - if Assigned( Self_.OnMouseDown ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseDown ) then + {$ENDIF} begin Button := mbMiddle; - Self_.OnMouseDown( Self_, MouseData ); + Self_.EV.fOnMouseDown( Self_, MouseData ); end; WM_LBUTTONUP: - if Assigned( Self_.OnMouseUp ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseUp ) then + {$ENDIF} begin Button := mbLeft; - Self_.OnMouseUp( Self_, MouseData ); + Self_.EV.fOnMouseUp( Self_, MouseData ); end; WM_RBUTTONUP: - if Assigned( Self_.OnMouseUp ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseUp ) then + {$ENDIF} begin Button := mbRight; - Self_.OnMouseUp( Self_, MouseData ); + Self_.EV.fOnMouseUp( Self_, MouseData ); end; WM_MBUTTONUP: - if Assigned( Self_.OnMouseUp ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseUp ) then + {$ENDIF} begin Button := mbMiddle; - Self_.OnMouseUp( Self_, MouseData ); + Self_.EV.fOnMouseUp( Self_, MouseData ); end; WM_MOUSEMOVE: - if Assigned( Self_.OnMouseMove ) then - Self_.OnMouseMove( Self_, MouseData ); + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseMove ) then + {$ENDIF} + Self_.EV.fOnMouseMove( Self_, MouseData ); WM_LBUTTONDBLCLK: - if Assigned( Self_.OnMouseDblClk ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseDblClk ) then + {$ENDIF} begin Button := mbLeft; - Self_.OnMouseDblClk( Self_, MouseData ); + Self_.EV.fOnMouseDblClk( Self_, MouseData ); end; WM_RBUTTONDBLCLK: - if Assigned( Self_.OnMouseDblClk ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseDblClk ) then + {$ENDIF} begin Button := mbRight; - Self_.OnMouseDblClk( Self_, MouseData ); + Self_.EV.fOnMouseDblClk( Self_, MouseData ); end; WM_MBUTTONDBLCLK: - if Assigned( Self_.OnMouseDblClk ) then + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseDblClk ) then + {$ENDIF} begin Button := mbMiddle; - Self_.OnMouseDblClk( Self_, MouseData ); + Self_.EV.fOnMouseDblClk( Self_, MouseData ); end; $020A {WM_MOUSEWHEEL}: - if Assigned( Self_.OnMouseWheel ) then - Self_.OnMouseWheel( Self_, MouseData ); + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseWheel ) then + {$ENDIF} + Self_.EV.fOnMouseWheel( Self_, MouseData ); else Exit; //Result := False; end; @@ -36919,9 +37377,7 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END WndProcMous] -//[FUNCTION WndProcKeybd] {$IFDEF ASM_UNICODE} function WndProcKeybd( Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; asm @@ -36932,23 +37388,32 @@ asm JA @@fin_false XCHG EBX, EAX // EBX = @Self XCHG EAX, ECX // EAX = message - WM_KEYFIRST - LEA ECX, [EBX].TControl.fOnKeyUp + {$IFDEF EVENTS_DYNAMIC} + MOV ECX, [EBX].TControl.EV + LEA ECX, [ECX].TEvents.fOnKeyUp + {$ELSE} + LEA ECX, [EBX].TControl.EV.fOnKeyUp + {$ENDIF} JZ @@event {$IFDEF PARANOIA} DB $34, 1 {$ELSE} XOR AL, 1 {$ENDIF} JZ @@event - LEA ECX, [EBX].TControl.fOnKeyDown + //LEA ECX, [EBX].TControl.EV.fOnKeyDown + ADD ECX, 8 {$IFDEF PARANOIA} DB $34, 1 {$ELSE} XOR AL, 1 {$ENDIF} JZ @@event {$IFDEF PARANOIA} DB $34, 4 {$ELSE} XOR AL, 4 {$ENDIF} JZ @@event - LEA ECX, [EBX].TControl.fOnChar + //LEA ECX, [EBX].TControl.EV.fOnChar + SUB ECX, 24 {$IFDEF PARANOIA} DB $34, 6 {$ELSE} XOR AL, 2 xor 4 {$ENDIF} JZ @@event {$IFDEF PARANOIA} DB $34, 4 {$ELSE} XOR AL, 6 xor 2 {$ENDIF} JNZ @@fin_false @@event: + {$IFDEF NIL_EVENTS} CMP word ptr [ECX].TMethod.Code+2, 0 JZ @@fin_false + {$ENDIF} PUSH EDX PUSH ECX LEA ECX, [EDX].TMsg.wParam @@ -36981,24 +37446,32 @@ begin Result := True; case Msg.message of WM_KEYDOWN, WM_SYSKEYDOWN: - if assigned( Self_.fOnKeyDown ) then - Self_.fOnKeyDown( Self_, Msg.wParam, GetShiftState ); + {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnKeyDown ) then + {$ENDIF} + Self_.EV.fOnKeyDown( Self_, Msg.wParam, GetShiftState ); WM_KEYUP, WM_SYSKEYUP: - if assigned( Self_.fOnKeyUp ) then - Self_.fOnKeyUp( Self_, Msg.wParam, GetShiftState ); + {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnKeyUp ) then + {$ENDIF} + Self_.EV.fOnKeyUp( Self_, Msg.wParam, GetShiftState ); WM_CHAR, WM_SYSCHAR: - if assigned( Self_.fOnChar ) then + {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnChar ) then + {$ENDIF} begin C := KOLChar( Msg.wParam ); - Self_.fOnChar( Self_, C, GetShiftState ); + Self_.EV.fOnChar( Self_, C, GetShiftState ); Msg.wParam := Integer( C ); end; {$IFDEF SUPPORT_ONDEADCHAR} WM_DEADCHAR, WM_SYSDEADCHAR: - if assigned( Self_.fOnDeadChar ) then + {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnDeadChar ) then + {$ENDIF} begin C := KOLChar( Msg.wParam ); - Self_.fOnDeadChar( Self_, C, GetShiftState ); + Self_.EV.fOnDeadChar( Self_, C, GetShiftState ); Msg.wParam := Integer( C ); end; {$ENDIF SUPPORT_ONDEADCHAR} @@ -37011,9 +37484,7 @@ begin Result := False; end; {$ENDIF ASM_VERSION} -//[END WndProcKeybd] -//[function WndProcDummy] function WndProcDummy(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; begin Result := False; @@ -37032,73 +37503,75 @@ begin {$IFDEF NEW_MODAL} // version of code by Alexander Pravdin begin - Accept := True; - if Assigned( Sender.fOnClose ) then begin - Sender.fOnClose( Sender, Accept ); - if AppletRunning then - if Accept then - if Sender.fModal > 0 then begin - if Sender.ModalResult = 0 then - Sender.fModalResult := Integer($80000000); - Msg.message := 0; - Exit; + Accept := True; + if Assigned( Sender.EV.fOnClose ) then + begin + Sender.EV.fOnClose( Sender, Accept ); + if AppletRunning then + if Accept then + if Sender.DF.fModal > 0 then + begin + if Sender.DF.fModalResult = 0 then + Sender.DF.fModalResult := Integer($80000000); + Msg.message := 0; + Exit; end else - Sender.fOnClose := nil - else begin - Rslt := 0; - Sender.fModalResult := 0; - Result := TRUE; - end + TMethod( Sender.EV.fOnClose ).Code := + {$IFDEF NIL_EVENTS} nil + {$ELSE} @DummyObjProc {$ENDIF} else - Sender.fOnClose := nil; - end - else begin - if Sender.fModal > 0 then begin - if Sender.ModalResult = 0 then - Sender.fModalResult := Integer($80000000); - Exit; - end; - end; - - if Accept then begin - if Sender.IsMainWindow or ( Applet = Sender ) then begin - {if Assigned( Applet ) and ( Applet <> Sender ) then - Applet.Perform( WM_CLOSE, 0, 0 );} - PostQuitMessage( 0 ); - Rslt := 0; + Rslt := 0; + Sender.DF.fModalResult := 0; + Result := TRUE; end - else - Exit; // Default; - end; + else TMethod( Sender.EV.fOnClose ).Code := + {$IFDEF NIL_EVENTS} nil + {$ELSE} @DummyObjProc {$ENDIF}; + end else + begin + if Sender.DF.fModal > 0 then begin + if Sender.DF.fModalResult = 0 then + Sender.DF.fModalResult := Integer($80000000); + Exit; + end; + end; + + if Accept then begin + if Sender.IsMainWindow or ( Applet = Sender ) then + begin + PostQuitMessage( 0 ); + Rslt := 0; + end + else + Exit; + end; end; {$ELSE} begin - Accept := True; - if Assigned( Sender.fOnClose ) then - begin - Sender.fOnClose( Sender, Accept ); - if (not Accept) and (AppletRunning) then - begin - Rslt := 0; - Result := TRUE; - end - else //+-+ - Sender.fOnClose := nil; - end; - if Accept then - begin - if Sender.IsMainWindow or (Applet = Sender) then - begin - {if Assigned( Applet ) and (Applet <> Sender) then - Applet.Perform( WM_CLOSE, 0, 0 );} - PostQuitMessage( 0 ); - Rslt := 0; - end - else - Exit; //Default; - end; + Accept := True; + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnClose ) then + {$ENDIF} + begin + Sender.EV.fOnClose( Sender, Accept ); + if (not Accept) and (AppletRunning) then + begin + Rslt := 0; + Result := TRUE; + end else + Sender.EV.fOnClose := nil; + end; + if Accept then + begin + if Sender.IsMainWindow or (Applet = Sender) then + begin + PostQuitMessage( 0 ); + Rslt := 0; + end else + Exit; //Default; + end; end; {$ENDIF} end; @@ -37106,28 +37579,39 @@ end; procedure TControl.SetOnClose(const AOnClose: TOnEventAccept); begin - fOnClose := AOnClose; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnClose := AOnClose; AttachProc( WndProcOnClose ); end; function WndProcFormOnClick( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin Result := FALSE; - if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_LBUTTONDBLCLK) or - (Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_RBUTTONDBLCLK) or - (Msg.message = WM_MBUTTONDOWN) or (Msg.message = WM_MBUTTONDBLCLK) + if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_LBUTTONDBLCLK) or + (Msg.message = WM_RBUTTONDOWN) or (Msg.message = WM_RBUTTONDBLCLK) or + (Msg.message = WM_MBUTTONDOWN) or (Msg.message = WM_MBUTTONDBLCLK) then begin - Sender.fRightClick := (Msg.message = WM_RBUTTONDOWN) or - (Msg.message = WM_RBUTTONDBLCLK); - if Assigned( Sender.fOnClick ) then - Sender.fOnClick( Sender ); + {$IFDEF USE_FLAGS} + if (Msg.message = WM_RBUTTONDOWN) or + (Msg.message = WM_RBUTTONDBLCLK) then + include( Sender.fFlagsG6, G6_RightClick ) + else exclude( Sender.fFlagsG6, G6_RightClick ); + {$ELSE} + Sender.fRightClick := (Msg.message = WM_RBUTTONDOWN) or + (Msg.message = WM_RBUTTONDBLCLK); + {$ENDIF} + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnClick ) then + {$ENDIF} + Sender.EV.fOnClick( Sender ); end; end; procedure TControl.SetFormOnClick(const AOnClick: TOnEvent); begin - fOnClick := AOnClick; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnClick := AOnClick; AttachProc( WndProcFormOnClick ); end; @@ -37151,7 +37635,6 @@ end; {$UNDEF ASM_LOCAL} {$ENDIF} -//[function TControl.WndProc] {$IFDEF ASM_LOCAL} {$ELSE ASM_LOCAL} //Pascal @@ -37183,190 +37666,202 @@ begin ' Msg.lParam=' + Int2Str( Msg.lParam ) + '=$' + Int2Hex( Msg.lParam, 4 ) ); {$ENDIF DEBUG_CREATEWINDOW} if (Msg.hwnd <> 0) and (fHandle = 0) - {$IFDEF USE_GRAPHCTLS} and fWindowed {$ENDIF} then + {$IFDEF USE_GRAPHCTLS} and + {$IFDEF USE_FLAGS} not(G6_GraphicCtl in fFlagsG6) + {$ELSE} fWindowed {$ENDIF} {$ENDIF} then fHandle := Msg.hwnd; {$IFDEF DEBUG_MCK} mck_Log( '01' ); {$ENDIF} - PassFun := fPass2DefProc; + PassFun := PP.fPass2DefProc; {$IFDEF DEBUG_MCK} mck_Log( '01' ); {$ENDIF} - if not (AppletRunning and (Applet <> @Self) and Assigned( Applet ) and - Assigned( Applet.OnMessage ) and Applet.OnMessage( Msg, Result )) then + if not (AppletRunning and (Applet <> @Self) and ( Applet <> nil ) and + {$IFDEF NIL_EVENTS} Assigned( Applet.EV.fOnMessage ) and {$ENDIF} + Applet.EV.fOnMessage( Msg, Result )) then begin {$IFDEF DEBUG_MCK} mck_Log( '02' ); {$ENDIF} - if not (Assigned( OnMessage ) and OnMessage( Msg, Result )) then - begin {$IFDEF DEBUG_MCK} mck_Log( '03' ); {$ENDIF} - if not fOnDynHandlers( @Self, Msg, Result ) then - begin {$IFDEF DEBUG_MCK} mck_Log( '04' ); {$ENDIF} - if not fWndProcResizeFlicks( @Self, Msg, Result ) then - begin {$IFDEF DEBUG_MCK} mck_Log( '05' ); {$ENDIF} - case Msg.message of - WM_CLOSE: - begin // handler by default - simple: - if (Applet = @ Self) or IsMainWindow then - PostQuitMessage( 0 ); - Default; - end; - {$IFDEF USE_PROP} - WM_NCDESTROY: - begin - RemoveProp( fHandle, ID_SELF ); //********* Added By M.Gerasimov - end; - {$ENDIF} - WM_DESTROY: - begin - fBeginDestroying := TRUE; - Default; - {$IFDEF INPACKAGE} - LogOK; - {$ENDIF INPACKAGE} - Exit; - end; - WM_SIZE: begin - {$IFDEF INPACKAGE} - Log( 'WM_SIZE >>> Default' ); - {$ENDIF INPACKAGE} - Default; - {$IFDEF INPACKAGE} - Log( '//// Default called' ); - {$ENDIF INPACKAGE} - fWindowState := TWindowState( Msg.wParam ); - {$IFDEF OLD_ALIGN} - if not fIsForm then - Global_Align( fParent ); - {$ENDIF} - {$IFDEF INPACKAGE} - Log( '//// Before Global_Align' ); - {$ENDIF INPACKAGE} - Global_Align( @Self ); - {$IFDEF INPACKAGE} - LogOK; - {$ENDIF INPACKAGE} - Exit; - end; - WM_SysCommand: - begin - if ((Msg.wParam and $FFF0) = SC_MINIMIZE) and - IsMainWindow and (@Self <> Applet) then - begin - PostMessage( Applet.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0 ); - Result := 0; - end - else Default; - end; - WM_SETFOCUS: - begin - if not DoSetFocus then - begin - Result := 0; - end - else - begin - Inc( fClickDisabled ); - Default; - Dec( fClickDisabled ); - {$IFDEF INPACKAGE} - LogOK; - {$ENDIF INPACKAGE} - Exit; - end; - end; - WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC: - begin - Result := SendMessage(Msg.LParam, CN_BASE + Msg.message, Msg.WParam, Msg.LParam); - end; - WM_COMMAND: - begin - {$IFDEF USE_PROP} - C := Pointer( GetProp( Msg.lParam, ID_SELF ) ); - {$ELSE} - C := Pointer( GetWindowLong( Msg.lParam, GWL_USERDATA ) ); - {$ENDIF} - if C <> nil then - begin - Result := SendMessage( Msg.lParam, CM_COMMAND, Msg.wParam, Msg.lParam ); - end - else Default; - end; - WM_KEYFIRST..WM_KEYLAST: - begin - F := GetFocus; - if (F <> fFocusHandle) and (F <> fHandle) - {$IFDEF USE_GRAPHCTLS} and fWindowed {$ENDIF} - {$IFDEF KEY_PREVIEW} - and not (fKeyPreviewing {and - ((Msg.Message=WM_KEYDOWN) {or (Msg.message = WM_CHAR) )}) - {$ENDIF} - then - begin - Result := 0; - // Jump to PassFun here. Prevents beep in case when WM_KEYDOWN - // called another form and focus is changed, so WM_KEYUP failed - // to handle. - end - else - begin - {$IFDEF KEY_PREVIEW} - fkeypreviewing:=false; //ADDITION JUST FOR CORRECT KEYPREVIEWING + if not ({$IFDEF NIL_EVENTS} Assigned( EV.fOnMessage ) and {$ENDIF} + EV.fOnMessage( Msg, Result )) then + begin {$IFDEF DEBUG_MCK} mck_Log( '03' ); {$ENDIF} + if not PP.fOnDynHandlers( @Self, Msg, Result ) then + begin {$IFDEF DEBUG_MCK} mck_Log( '04' ); {$ENDIF} + //{-2.95}//if not PP.fWndProcResizeFlicks( @Self, Msg, Result ) then + begin {$IFDEF DEBUG_MCK} mck_Log( '05' ); {$ENDIF} + case Msg.message of + WM_CLOSE: + begin // handler by default - simple: + if (Applet = @ Self) or IsMainWindow then + PostQuitMessage( 0 ); + Default; + end; + {$IFDEF USE_PROP} + WM_NCDESTROY: + begin + RemoveProp( fHandle, ID_SELF ); //********* Added By M.Gerasimov + end; {$ENDIF} - if fGlobalProcKeybd( @Self, Msg, Result ) then + WM_DESTROY: + begin + {$IFDEF USE_FLAGS} include( fFlagsG2, G2_BeginDestroying ); + {$ELSE} fBeginDestroying := TRUE; {$ENDIF} + Default; + {$IFDEF INPACKAGE} + LogOK; + {$ENDIF INPACKAGE} + Exit; + end; + WM_SIZE: begin + {$IFDEF INPACKAGE} + Log( 'WM_SIZE >>> Default' ); + {$ENDIF INPACKAGE} + Default; + {$IFDEF INPACKAGE} + Log( '//// Default called' ); + {$ENDIF INPACKAGE} + {$IFDEF OLD_ALIGN} + if {$IFDEF USE_FLAGS} not(G3_IsForm in fFlagsG3) + {$ELSE} not fIsForm {$ENDIF} then + Global_Align( fParent ); + {$ENDIF} + {$IFDEF INPACKAGE} + Log( '//// Before Global_Align' ); + {$ENDIF INPACKAGE} + Global_Align( @Self ); + {$IFDEF INPACKAGE} + LogOK; + {$ENDIF INPACKAGE} + Exit; + end; + WM_SysCommand: + begin + if ((Msg.wParam and $FFF0) = SC_MINIMIZE) and + IsMainWindow and (@Self <> Applet) then + begin + PostMessage( Applet.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0 ); + Result := 0; + end + else Default; + end; + WM_SETFOCUS: + begin + if not DoSetFocus then + begin + Result := 0; + end + else + begin + Inc( fClickDisabled ); + Default; + Dec( fClickDisabled ); + {$IFDEF INPACKAGE} + LogOK; + {$ENDIF INPACKAGE} + Exit; + end; + end; + WM_CTLCOLORMSGBOX..WM_CTLCOLORSTATIC: begin - {$IFDEF INPACKAGE} - LogOK; - {$ENDIF INPACKAGE} - Exit; //?????????????????? + Result := SendMessage(Msg.LParam, CN_BASE + Msg.message, Msg.WParam, Msg.LParam); end; - if fWndProcKeybd( @Self, Msg, Result ) then - begin - {$IFDEF INPACKAGE} - LogOK; - {$ENDIF INPACKAGE} - Exit; //??????????????????? + WM_COMMAND: + begin + {$IFDEF USE_PROP} + C := Pointer( GetProp( Msg.lParam, ID_SELF ) ); + {$ELSE} + C := Pointer( GetWindowLong( Msg.lParam, GWL_USERDATA ) ); + {$ENDIF} + if C <> nil then + begin + Result := SendMessage( Msg.lParam, CM_COMMAND, Msg.wParam, Msg.lParam ); + end + else Default; + end; + WM_KEYFIRST..WM_KEYLAST: + begin + F := GetFocus; + if {(F <> fFocusHandle) and} (F <> fHandle) + {$IFDEF USE_GRAPHCTLS} and + {$IFDEF USE_FLAGS} not(G6_GraphicCtl in fFlagsG6) + {$ELSE} fWindowed {$ENDIF} {$ENDIF} + {$IFDEF KEY_PREVIEW} + and {$IFDEF USE_FLAGS} not(G4_Pushed in fFlagsG4) + {$ELSE} not fKeyPreviewing {$ENDIF} + {$ENDIF} + then + begin + Result := 0; + // Jump to PassFun here. Prevents beep in case when WM_KEYDOWN + // called another form and focus is changed, so WM_KEYUP failed + // to handle. + end + else + begin + {$IFDEF KEY_PREVIEW} //ADDITION JUST FOR CORRECT KEYPREVIEWING + {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_Pushed ); + {$ELSE} fKeyPreviewing:=false; {$ENDIF} + {$ENDIF} + if fGlobalProcKeybd( @Self, Msg, Result ) then + begin + {$IFDEF INPACKAGE} + LogOK; + {$ENDIF INPACKAGE} + Exit; //?????????????????? + end; + if PP.fWndProcKeybd( @Self, Msg, Result ) then + begin + {$IFDEF INPACKAGE} + LogOK; + {$ENDIF INPACKAGE} + Exit; //??????????????????? + end; + if ((GetKeystate( VK_CONTROL ) or GetKeyState( VK_MENU )) >= 0) then + begin + //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + if (Msg.message <> WM_CHAR) // v1.02 Tabulate AND " in EditBox fix + //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + then + begin + C := ParentForm; + if (C <> nil) + {$IFDEF NIL_EVENTS} + and Assigned(C.PP.fGotoControl) + {$ENDIF} + and C.PP.fGotoControl( @Self, Msg.wParam, + (Msg.message <> WM_KEYDOWN) and + (Msg.message <> WM_SYSKEYDOWN) ) then + begin + Msg.wParam := 0; + Result := 0; + end + else Default; + end + //+++++++++++++++++++++++++++++++++++++++++++++// + else // + if Msg.wParam = 9 then // prevent system beep // + begin // + Msg.wParam := 0; // + Result := 0; // + end // + //+++++++++++++++++++++++++++++++++++++++++++++// + else Default; + end + else Default; + end; + end; + else begin + {$IFDEF DEBUG_MCK} mck_Log( 'else' ); {$ENDIF} + Default; //+-+ + {$IFDEF INPACKAGE} + LogOK; + {$ENDIF INPACKAGE} + Exit; //+-+ + end; end; - if ((GetKeystate( VK_CONTROL ) or GetKeyState( VK_MENU )) >= 0) then - begin - //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - if (Msg.message <> WM_CHAR) // v1.02 Tabulate AND " in EditBox fix - //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - then - begin - C := ParentForm; - if (C <> nil) and Assigned(C.fGotoControl) and - C.fGotoControl( @Self, Msg.wParam, - (Msg.message <> WM_KEYDOWN) and - (Msg.message <> WM_SYSKEYDOWN) ) then - begin - Msg.wParam := 0; - Result := 0; - end - else Default; - end - //+++++++++++++++++++++++++++++++++++++++++++++// - else // - if Msg.wParam = 9 then // prevent system beep // - begin // - Msg.wParam := 0; // - Result := 0; // - end // - //+++++++++++++++++++++++++++++++++++++++++++++// - else Default; - end - else Default; - end; end; - else begin - {$IFDEF DEBUG_MCK} mck_Log( 'else' ); {$ENDIF} - Default; //+-+ - {$IFDEF INPACKAGE} - LogOK; - {$ENDIF INPACKAGE} - Exit; //+-+ end; - end; - end; - end; - end; + end; end; {$IFDEF DEBUG_MCK} mck_Log( '06' ); {$ENDIF} - if not AppletTerminated and not fNCDestroyed then + if not AppletTerminated + {$IFDEF USE_fNCDestroyed} and not fNCDestroyed {$ENDIF} then begin {$IFDEF DEBUG_MCK} mck_Log( '07' ); {$ENDIF} PassFun( @Self, Msg, Result ); //+-+ {$IFDEF DEBUG_MCK} mck_Log( '08' ); {$ENDIF} @@ -37379,12 +37874,10 @@ begin {$ENDIF INPACKAGE} end; {$ENDIF ASM_LOCAL} -//[END TContro] {$UNDEF ASM_LOCAL} {$ENDIF WIN_GDI} -//[procedure SetMouseEvent] {$IFDEF GDI} procedure SetMouseEvent( Self_: PControl ); begin @@ -37393,11 +37886,12 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function mouse_events_handler( Obj: PGtkWidget; var Event: TGdkEventAny ): Boolean; cdecl; -var Sender: PControl; +FUNCTION mouse_events_handler( Obj: PGtkWidget; VAR Event: TGdkEventAny ): Boolean; + CDECL; +VAR Sender: PControl; M: TMouseEventData; - procedure PrepareMouseEvent( const Evt: TGdkEventMotion ); - begin + PROCEDURE PrepareMouseEvent( const Evt: TGdkEventMotion ); + BEGIN M.Button := mbNone; if Evt.state and GDK_BUTTON1_MASK <> 0 then M.Button := mbLeft else @@ -37414,10 +37908,10 @@ var Sender: PControl; if Evt.state and GDK_LOCK_MASK <> 0 then M.Shift := M.Shift or MK_LOCK; M.X := Round( Evt.x ); M.Y := Round( Evt.y ); - end; -var scrl: PGdkEventScroll; + END; +VAR scrl: PGdkEventScroll; z: SmallInt; -begin +BEGIN Result := FALSE; //Sender := Pointer( Event.window ); Sender := g_object_get_data( G_OBJECT( Obj ), ID_SELF ); @@ -37433,163 +37927,89 @@ begin PrepareMouseEvent( PGdkEventMotion( @ Event )^ ); CASE Event._type OF GDK_MOTION_NOTIFY : - begin - if Assigned( Sender.fOnMouseMove ) then - begin - Sender.fOnMouseMove( Sender, M ); - Result := TRUE; - end; - end; + BEGIN + IF Assigned( Sender.fOnMouseMove ) THEN + BEGIN + Sender.fOnMouseMove( Sender, M ); + Result := TRUE; + END; + END; GDK_BUTTON_PRESS : - begin - if Assigned( Sender.fOnMouseDown ) then - begin - Sender.fOnMouseDown( Sender, M ); - Result := TRUE; - end; - end; + BEGIN + IF Assigned( Sender.fOnMouseDown ) THEN + BEGIN + Sender.fOnMouseDown( Sender, M ); + Result := TRUE; + END; + END; GDK_2BUTTON_PRESS, GDK_3BUTTON_PRESS : - begin - if Assigned( Sender.fOnMouseDblClk ) then - begin + BEGIN + IF Assigned( Sender.fOnMouseDblClk ) THEN + BEGIN + {$IFDEF USE_FLAGS} + IF Event._type = GDK_3BUTTON_PRESS THEN + include( Sender.fFlagsG5, G5_3ButtonPress ) + ELSE exclude( Sender.fFlagsG5, G5_3ButtonPress ); + {$ELSE} Sender.f3ButtonPress := Event._type = GDK_3BUTTON_PRESS; + {$ENDIF} Sender.fOnMouseDblClk( Sender, M ); Result := TRUE; - end; - end; + END; + END; GDK_BUTTON_RELEASE : - begin - if Assigned( Sender.fOnMouseUp ) then - begin + BEGIN + IF Assigned( Sender.fOnMouseUp ) THEN + BEGIN Sender.fOnMouseUp( Sender, M ); Result := TRUE; - end; + END; if Assigned( Sender.fOnClick ) then Sender.fOnClick( Sender ); - end; + END; GDK_SCROLL : - begin - if Assigned( Sender.fOnMouseWheel ) then - begin - scrl := @ Event; - if scrl.direction = GDK_SCROLL_UP then - z := 120 - else if scrl.direction = GDK_SCROLL_DOWN then - z := -120 //todo: direction and value? - else - z := 0; - M.Shift := M.Shift or DWord(z shl 16); - Sender.fOnMouseWheel( Sender, M ); - Result := TRUE; - end; - end; + BEGIN + IF Assigned( Sender.fOnMouseWheel ) THEN + BEGIN + scrl := @ Event; + IF scrl.direction = GDK_SCROLL_UP THEN + z := 120 + ELSE IF scrl.direction = GDK_SCROLL_DOWN THEN + z := -120 //todo: direction and value? + ELSE + z := 0; + M.Shift := M.Shift or DWord(z shl 16); + Sender.fOnMouseWheel( Sender, M ); + Result := TRUE; + END; + END; END; -end; +END; -procedure SetMouseEvent( Self_: PControl; event_name: PAnsiChar ); -begin +PROCEDURE SetMouseEvent( Self_: PControl; event_name: PAnsiChar ); +BEGIN gtk_signal_connect( GTK_OBJECT( Self_.fEventboxHandle ), event_name, @mouse_events_handler, Self_ ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[procedure TControl.SetOnMouseDown] -{$IFDEF GDI} -procedure TControl.SetOnMouseDown(const Value: TOnMouse); +function TControl.Get_OnMouseEvent(const Index: Integer): TOnMouse; begin - fOnMouseDown := Value; - SetMouseEvent( @Self ); + Result := TOnMouse( EV.MethodEvents[Index] ); end; -{$ENDIF GDI} -{$IFDEF _X_} -{$IFDEF GTK} -procedure TControl.SetOnMouseDown(const Value: TOnMouse); -begin - fOnMouseDown := Value; - SetMouseEvent( @Self, 'button_press_event' ); -end; -{$ENDIF GTK} -{$ENDIF _X_} -{$IFDEF GDI} -//[procedure TControl.SetOnMouseMove] -procedure TControl.SetOnMouseMove(const Value: TOnMouse); +procedure TControl.SetOnMouseEvent(const Index: Integer; + const Value: TOnMouse); begin - fOnMouseMove := Value; - SetMouseEvent( @Self ); + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .MethodEvents[Index] := TMethod( Value ); + AttachProc( WndProcMouse ); end; -{$ENDIF GDI} -{$IFDEF _X_} -{$IFDEF GTK} -procedure TControl.SetOnMouseMove(const Value: TOnMouse); -begin - fOnMouseMove := Value; - SetMouseEvent( @Self, 'motion_notify_event' ); -end; -{$ENDIF GTK} -{$ENDIF _X_} - -//[procedure TControl.SetOnMouseUp] -{$IFDEF GDI} -procedure TControl.SetOnMouseUp(const Value: TOnMouse); -begin - fOnMouseUp := Value; - SetMouseEvent( @Self ); -end; -{$ENDIF GDI} -{$IFDEF _X_} -{$IFDEF GTK} -procedure TControl.SetOnMouseUp(const Value: TOnMouse); -begin - fOnMouseUp := Value; - SetMouseEvent( @Self, 'button_release_event' ); -end; -{$ENDIF GTK} -{$ENDIF _X_} - -//[procedure TControl.SetOnMouseDblClk] -{$IFDEF GDI} -procedure TControl.SetOnMouseDblClk(const Value: TOnMouse); -begin - fOnMouseDblClk := Value; - SetMouseEvent( @Self ); -end; -{$ENDIF GDI} -{$IFDEF _X_} -{$IFDEF GTK} -procedure TControl.SetOnMouseDblClk(const Value: TOnMouse); -begin - fOnMouseDblClk := Value; - SetMouseEvent( @Self, 'button_press_event' ); -end; -{$ENDIF GTK} -{$ENDIF _X_} - -//[procedure TControl.SetOnMouseWheel] -{$IFDEF GDI} -procedure TControl.SetOnMouseWheel(const Value: TOnMouse); -begin - fOnMouseWheel := Value; - SetMouseEvent( @Self ); -end; -{$ENDIF GDI} -{$IFDEF _X_} -{$IFDEF GTK} -procedure TControl.SetOnMouseWheel(const Value: TOnMouse); -begin - fOnMouseWheel := Value; - SetMouseEvent( @Self, 'scroll_event' ); -end; -{$ENDIF GTK} -{$ENDIF _X_} - {$IFDEF WIN_GDI} -//[procedure TControl.SetClsStyle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetClsStyle( Value: DWord ); begin if fClsStyle = Value then Exit; @@ -37599,13 +38019,11 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetStyle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetStyle( Value: DWord ); begin - if fStyle = Value then Exit; - fStyle := Value; + if fStyle.Value = Value then Exit; + fStyle.Value := Value; if fHandle = 0 then Exit; SetWindowLong( fHandle, GWL_STYLE, Value ); @@ -37617,20 +38035,34 @@ end; {$ENDIF ASM_VERSION} {$IFDEF GRAPHCTL_XPSTYLES} +function TControl.GetEdgeStyle: TEdgeStyle; +begin + Result := esRaised; + if Style and WS_DLGFRAME = 0 then + begin + if Style and SS_SUNKEN <> 0 then + Result := esLowered + else + Result := esNone; + end; +end; + procedure TControl.SetEdgeStyle( Value: TEdgeStyle ); begin + {$IFDEF STORE_EDGESTYLE} if fedgeStyle = Value then Exit; fedgeStyle := Value; + {$ENDIF} if fHandle = 0 then Exit; case Value of - esRaised: + esRaised: begin Style := Style and (not SS_SUNKEN); ExStyle := ExStyle and (not WS_EX_STATICEDGE); ExStyle := ExStyle or WS_EX_WINDOWEDGE; Style := Style or WS_DLGFRAME; end; - esLowered: + esLowered: begin Style := Style and (not WS_DLGFRAME); ExStyle := ExStyle or WS_EX_WINDOWEDGE; @@ -37638,17 +38070,15 @@ begin Style := Style or SS_SUNKEN; end; else - Style := Style and (not SS_SUNKEN) and (not WS_DLGFRAME); - ExStyle := ExStyle and (not WS_EX_STATICEDGE) or WS_EX_WINDOWEDGE; + Style := Style and (not SS_SUNKEN) and (not WS_DLGFRAME); + ExStyle := ExStyle and (not WS_EX_STATICEDGE) or WS_EX_WINDOWEDGE; end; Invalidate; end; {$ENDIF} -//[procedure TControl.SetExStyle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetExStyle( Value: DWord ); begin if fExStyle = Value then Exit; @@ -37686,9 +38116,7 @@ begin end; end; -//[procedure TControl.SetCursor] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetCursor( Value: HCursor ); var P: TPoint; begin @@ -37704,32 +38132,28 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.CursorLoad] procedure TControl.CursorLoad(Inst: Integer; ResName: PKOLChar); begin Cursor := LoadCursor( Inst, ResName ); - fCursorShared := TRUE; + //{$IFDEF USE_FLAGS} include( fFlagsG1, G1_CursorShared ); + //{$ELSE} fCursorShared := TRUE; {$ENDIF} end; -//[procedure TControl.SetIcon] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetIcon( Value: HIcon ); var OldIco: HIcon; begin - if fIcon = Value then Exit; - fIcon := Value; - if Value = THandle(-1) then - Value := 0; + if DF.fIcon = Value then Exit; + DF.fIcon := Value; + if Value = THandle(-1) then + Value := 0; OldIco := Perform( WM_SETICON, 1 {ICON_BIG}, Value ); - if OldIco <> 0 then - DestroyIcon( OldIco ); + if OldIco <> 0 then + DestroyIcon( OldIco ); end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetMenu] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetMenu( Value: HMenu ); begin if fMenu = Value then Exit; @@ -37748,7 +38172,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure CallWinHelp] procedure CallWinHelp( Context: Integer; CtxCtl: PControl ); var Cmd: Integer; Form: PControl; @@ -37759,10 +38182,10 @@ begin begin Form := CtxCtl.ParentForm; if Form <> nil then - if Assigned( Form.OnHelp ) then + if Assigned( Form.EV.fOnHelp ) then begin Popup := FALSE; - Form.OnHelp( CtxCtl, Context, Popup ); + Form.EV.fOnHelp( CtxCtl, Context, Popup ); if Popup then Cmd := HELP_CONTEXTPOPUP; if CtxCtl = nil then Exit; @@ -37775,21 +38198,20 @@ begin end; var HHCtrl: THandle; - HtmlHelp: procedure( Wnd: HWnd; Path: PAnsiChar; Cmd, Data: Integer ); stdcall; + HtmlHelp: procedure( Wnd: HWnd; Path: PKOLChar; Cmd, Data: Integer ); stdcall; -//[procedure HtmlHelpCommand] -procedure HtmlHelpCommand( Wnd: HWnd; const HelpFilePath: AnsiString; Cmd, Data: Integer ); +procedure HtmlHelpCommand( Wnd: HWnd; const HelpFilePath: KOLString; Cmd, Data: Integer ); begin - if HHCtrl = 0 then - HHCtrl := LoadLibrary( 'HHCTRL.OCX' ); - if HHCtrl = 0 then Exit; - if not Assigned( HtmlHelp ) then - HtmlHelp := GetProcAddress( HHCtrl, 'HtmlHelpA' ); - if not Assigned( HtmlHelp ) then Exit; - HtmlHelp( Wnd, PAnsiChar( HelpFilePath ), Cmd, Data ); + if HHCtrl = 0 then + HHCtrl := LoadLibrary( 'HHCTRL.OCX' ); + if HHCtrl = 0 then Exit; + if not Assigned( HtmlHelp ) then + HtmlHelp := GetProcAddress( HHCtrl, + {$IFDEF UNICODE_CTRLS} 'HtmlHelpW' {$ELSE} 'HtmlHelpA' {$ENDIF} ); + if not Assigned( HtmlHelp ) then Exit; + HtmlHelp( Wnd, PKOLChar( HelpFilePath ), Cmd, Data ); end; -//[procedure CallHtmlHelp] procedure CallHtmlHelp( Context: Integer; CtxCtl: PControl ); var Cmd: Integer; Form: PControl; @@ -37802,10 +38224,10 @@ begin begin Form := CtxCtl.ParentForm; if Form <> nil then - if Assigned( Form.OnHelp ) then + if Assigned( Form.EV.fOnHelp ) then begin Popup := FALSE; - Form.OnHelp( CtxCtl, Context, Popup ); + Form.EV.fOnHelp( CtxCtl, Context, Popup ); if Popup then begin Cmd := $10; //HH_TP_HELPCONTEXTMENU; @@ -37828,7 +38250,6 @@ end; var Global_HelpProc: procedure( Context: Integer; CtxCtl: PControl ) = CallWinHelp; -//[function WndProcHelp] function WndProcHelp( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var HI: PHelpInfo; Ctx: Integer; @@ -37849,7 +38270,7 @@ begin {$ENDIF} while Ctl <> nil do begin - Ctx := Ctl.fHelpContext; + Ctx := Ctl.HelpContext; if Ctx <> 0 then break; Ctl := Ctl.Parent; end; @@ -37869,9 +38290,9 @@ begin {$ELSE} Ctl := Pointer( GetWindowLong( Msg.wParam, GWL_USERDATA ) ); {$ENDIF} - if (Ctl <> nil) and (Ctl.fHelpContext <> 0) then + if (Ctl <> nil) and (Ctl.HelpContext <> 0) then begin - Applet.CallHelp( Ctl.fHelpContext, Ctl ); + Applet.CallHelp( Ctl.HelpContext, Ctl ); Rslt := 1; Result := TRUE; end; @@ -37879,46 +38300,43 @@ begin {$ENDIF}; end; -//[procedure TControl.SetHelpContext] procedure TControl.SetHelpContext(Value: Integer); var F: PControl; begin - fHelpContext := Value; + //fHelpContext := Value; F := ParentForm; if F = nil then Exit; F.AttachProc( WndProcHelp ); SetWindowContextHelpId( GetWindowHandle, Value ); end; -//[function TControl.AssignHelpContext] function TControl.AssignHelpContext(Context: Integer): PControl; begin SetHelpContext( Context ); Result := @ Self; end; -//[procedure AssignHtmlHelp] procedure AssignHtmlHelp( const HtmlHelpPath: KOLString ); +var Lbytes: Integer; begin Assert( (HtmlHelpPath <> '') and (Applet <> nil), 'Error parameters' ); if HelpFilePath <> '' then FreeMem( HelpFilePath ); - GetMem( HelpFilePath, (Length( HtmlHelpPath ) + 1) * Sizeof( KOLChar ) ); - StrCopy( HelpFilePath, @ HtmlHelpPath[ 1 ] ); + Lbytes := (Length( HtmlHelpPath ) + 1) * Sizeof( KOLChar ); + GetMem( HelpFilePath, Lbytes ); + Move( HtmlHelpPath[ 1 ], HelpFilePath^, Lbytes ); Global_HelpProc := CallHtmlHelp; Applet.AttachProc( WndProcHelp ); end; -//[procedure TControl.CallHelp] procedure TControl.CallHelp(Context: Integer; CtxCtl: PControl {; CtlID: Integer} ); begin Global_HelpProc( Context, CtxCtl {, CtlID} ); end; -//[function TControl.GetHelpPath] function TControl.GetHelpPath: KOLString; begin - Result := AnsiString(HelpFilePath); + Result := KOLString(HelpFilePath); if Result = '' then begin Result := ParamStr( 0 ); @@ -37926,36 +38344,41 @@ begin end; end; -//[procedure TControl.SetHelpPath] procedure TControl.SetHelpPath(const Value: KOLString); +var Lbytes: Integer; begin Assert( Value <> '', 'Error parameter' ); - if HelpFilePath <> '' then - FreeMem( HelpFilePath ); - GetMem( HelpFilePath, (Length( Value ) + 1)*Sizeof( KOLChar ) ); - StrCopy( HelpFilePath, @ Value[ 1 ] ); + if HelpFilePath <> '' then + FreeMem( HelpFilePath ); + Lbytes := (Length( Value ) + 1)*Sizeof( KOLChar ); + GetMem( HelpFilePath, Lbytes ); + Move( Value[ 1 ], HelpFilePath^, Lbytes ); end; {$ENDIF WIN_GDI} -{$IFDEF ASM_VERSION} -{$ELSE} +{$IFDEF ASM_VERSION}{$ELSE} procedure TControl.DoAutoSize; begin - if Assigned( fAutoSize ) then - fAutoSize( @Self ); + {$IFDEF NIL_EVENTS} + if Assigned( PP.fAutoSize ) then + {$ENDIF} + PP.fAutoSize( @Self ); end; {$ENDIF} {$IFDEF GDI} {$IFDEF ASM_UNICODE} -//[function TControl.GetCaption] function TControl.GetCaption: KOLString; asm PUSH EBX PUSH EDI XCHG EBX, EAX MOV EDI, EDX + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG1, (1 shl G1_IgnoreWndCaption) + {$ELSE} CMP [EBX].fIgnoreWndCaption, 0 + {$ENDIF USE_FLAGS} JNZ @@getFCaption MOV ECX, [EBX].fHandle JECXZ @@getFCaption @@ -37990,18 +38413,20 @@ end; function TControl.GetCaption: KOLString; var Sz: Integer; begin - if not fIgnoreWndCaption and (FHandle <> 0) then + if {$IFDEF USE_FLAGS} not(G1_IgnoreWndCaption in fFlagsG1) + {$ELSE} not fIgnoreWndCaption {$ENDIF} + and (FHandle <> 0) then begin - Sz := GetWindowTextLength( FHandle ); - SetLength( fCaption, Sz ); - if Sz > 0 then - begin - {$IFNDEF UNICODE_CTRLS} - GetWindowText( FHandle, @ fCaption[ 1 ], Sz + 1 ); - {$ELSE} - GetWindowTextW( FHandle, @ fCaption[ 1 ], Sz + 1 ); - {$ENDIF} - end; + Sz := GetWindowTextLength( FHandle ); + SetLength( fCaption, Sz ); + if Sz > 0 then + begin + {$IFNDEF UNICODE_CTRLS} + GetWindowText( FHandle, @ fCaption[ 1 ], Sz + 1 ); + {$ELSE} + GetWindowTextW( FHandle, @ fCaption[ 1 ], Sz + 1 ); + {$ENDIF} + end; end; Result := FCaption; end; @@ -38009,126 +38434,144 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function TControl.GetCaption: KOLString; -begin - if not fIgnoreWndCaption {and (FHandle <> 0)} then - FCaption := fGetCaption(@Self); +FUNCTION TControl.GetCaption: KOLString; +BEGIN + if {$IFDEF USE_FLAGS} not (G1_IgnoreWndCaption in fFlagsG1) + {$ELSE} fIgnoreWndCaption {$ENDIF} then + FCaption := fGetCaption(@Self); Result := FCaption; -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF GDI} -//[procedure TControl.SetCaption] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetCaption( const Value: KOLString ); begin fCaption := Value; if fHandle <> 0 then SendMessage( fHandle, WM_SETTEXT, 0, Integer( PKOLChar( Value ) ) ); - if fIsStaticControl <> 1 then - Invalidate; + if {$IFDEF USE_FLAGS} (G1_IsStaticControl in fFlagsG1) + {$ELSE} fIsStaticControl <> 1 {$ENDIF} then + Invalidate; DoAutoSize; end; {$ENDIF ASM_VERSION} {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TControl.SetCaption( const Value: KOLString ); -begin +PROCEDURE TControl.SetCaption( CONST Value: KOLString ); +BEGIN fCaption := Value; - if Assigned( fSetCaption ) then fSetCaption( @Self, Value ); + if Assigned( fSetCaption ) THEN + fSetCaption( @Self, Value ); DoAutoSize; -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -//[function TControl.GetVisible] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} function TControl.GetVisible: Boolean; begin + {$IFDEF USE_FLAGS} + if (fHandle <> 0) then + Result := IsWindowVisible( fHandle ) + else + Result := F3_Visible in fStyle.f3_Style; + {$ELSE} if (fHandle <> 0) then fVisible := IsWindowVisible( fHandle ) else - fVisible := (FStyle and WS_VISIBLE) <> 0; + fVisible := (FStyle.Value and WS_VISIBLE) <> 0; Result := fVisible; + {$ENDIF} end; {$ENDIF ASM_VERSION} -//[function TControl.Get_Visible] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} // Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} // Pascal function TControl.Get_Visible: Boolean; begin + {$IFDEF USE_FLAGS} + Result := GetVisible; + {$ELSE} if (fHandle <> 0) and not fIsControl then fVisible := IsWindowVisible( fHandle ); Result := fVisible; + {$ENDIF} end; {$ENDIF ASM_VERSION} -//[procedure TControl.Set_Visible] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} // Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} // Pascal procedure TControl.Set_Visible( Value: Boolean ); {$IFDEF OLD_ALIGN} var CmdShow: DWORD; +{$ENDIF} begin + {$IFDEF OLD_ALIGN} //if Get_Visible <> Value then // commented to allow to set up controls visibility begin // on invisible form (Vladimir Piven) - if Value then + if Value then begin - fStyle := fStyle or WS_VISIBLE; - CmdShow := SW_SHOW; - end - else + {$IFDEF USE_FLAGS} include( fStyle.f3_Style, F3_Visible ); + {$ELSE} fStyle.Value := fStyle.Value or WS_VISIBLE; {$ENDIF} + CmdShow := SW_SHOW; + end else begin - fStyle := fStyle and not WS_VISIBLE; - CmdShow := SW_HIDE; + {$IFDEF USE_FLAGS} exclude( fStyle.f3_Style, F3_Visible ); + {$ELSE} fStyle.Value := fStyle.Value and not WS_VISIBLE; {$ENDIF} + CmdShow := SW_HIDE; end; + {$IFDEF USE_FLAGS}{$ELSE} fVisible := Value; + {$ENDIF} if fHandle = 0 then Exit; ShowWindow( fHandle, CmdShow ); Global_Align( fParent ); - if Value then - Global_Align( @Self ); + if Value then + Global_Align( @Self ); end; - if not Value and (fHandle <> 0) then - fCreateHidden := FALSE; // { +++ } + if not Value and (fHandle <> 0) then + {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_CreateHidden ); + {$ELSE} fCreateHidden := FALSE; {$ENDIF} // { +++ } {$ELSE NEW_ALIGN} -begin - fStyle := fStyle and not WS_VISIBLE; - if Value then - fStyle := fStyle or WS_VISIBLE; + fStyle.Value := fStyle.Value and not WS_VISIBLE; + if Value then + fStyle.Value := fStyle.Value or WS_VISIBLE; + {$IFDEF USE_FLAGS} + {$ELSE} fVisible := Value; - if fHandle = 0 then Exit; - if Value then begin - Global_Align( @Self ); - ShowWindow( fHandle, SW_SHOW ); - end else begin - fCreateHidden := FALSE; // { +++ } - ShowWindow( fHandle, SW_HIDE ); - Global_Align( @Self ); + {$ENDIF} + if fHandle = 0 then Exit; + if Value then + begin + Global_Align( @Self ); + ShowWindow( fHandle, SW_SHOW ); + end else + begin + {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_CreateHidden ); + {$ELSE} fCreateHidden := FALSE; {$ENDIF} // { +++ } + ShowWindow( fHandle, SW_HIDE ); + Global_Align( @Self ); end; {$ENDIF} end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetVisible] +{$IFDEF ASM_VERSION}{$ELSE PASCAL} procedure TControl.SetVisible( Value: Boolean ); begin - fCreateVisible := TRUE; - Set_Visible( Value ); + {$IFDEF USE_FLAGS} include( fFlagsG4, G4_CreateVisible ); + {$ELSE} fCreateVisible := TRUE; {$ENDIF} + Set_Visible( Value ); end; +{$ENDIF ASM_VERSION} + {$ENDIF WIN_GDI} -//[function TControl.GetBoundsRect] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetBoundsRect: TRect; var W: HWnd; P: TPoint; @@ -38137,7 +38580,9 @@ begin if fHandle <> 0 then begin GetWindowRect( fHandle, Result ); - if fIsControl or fIsMDIChild then + if {$IFDEF USE_FLAGS} ([G3_IsControl, G3_IsMDIChild] * fFlagsG3 <> []) + {$ELSE} fIsControl or fIsMDIChild {$ENDIF} + then begin W := ParentWindow; if W <> 0 then @@ -38155,53 +38600,57 @@ begin end; {$ENDIF ASM_VERSION} {$ENDIF GDI} + {$IFDEF _X_} {$IFDEF GTK} -function TControl.GetBoundsRect: TRect; -var R: TRect; +FUNCTION TControl.GetBoundsRect: TRect; +VAR R: TRect; window: PGtkWindow; requisition: TGtkRequisition; -begin +BEGIN //if fHandle <> nil then - begin - if fIsControl then - begin - R.Left := fBoundsRect.Left; - R.Top := fBoundsRect.Top; - gtk_widget_get_size_request( fEventboxHandle, @ R.Right, @ R.Bottom ); - gtk_widget_size_request( fHandle, @ requisition ); - if R.Right < 0 then R.Right := requisition.width; - if R.Bottom < 0 then R.Bottom := requisition.height; - end - else - begin - window := GTK_WINDOW( fHandle ); - gtk_window_get_position(window, @ R.Left, @ R.Top); - gtk_window_get_size(window, @ R.Right, @ R.Bottom); - end; + BEGIN + IF fIsControl THEN + BEGIN + R.Left := fBoundsRect.Left; + R.Top := fBoundsRect.Top; + gtk_widget_get_size_request( fEventboxHandle, @ R.Right, @ R.Bottom ); + gtk_widget_size_request( fHandle, @ requisition ); + IF R.Right < 0 THEN R.Right := requisition.width; + IF R.Bottom < 0 THEN R.Bottom := requisition.height; + END ELSE + BEGIN + window := GTK_WINDOW( fHandle ); + gtk_window_get_position(window, @ R.Left, @ R.Top); + gtk_window_get_size(window, @ R.Right, @ R.Bottom); + END; inc( R.Right, R.Left ); inc( R.Bottom, R.Top ); fBoundsRect := R; - end; + END; Result := fBoundsRect; -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF GDI} -//[procedure TControl.SetBoundsRect] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetBoundsRect( const Value: TRect ); var Rect: TRect; begin Rect := GetBoundsRect; if RectsEqual( Value, Rect ) then Exit; + {$IFDEF USE_FLAGS} + if (Value.Left <> fBoundsRect.Left) or (Value.Top <> fBoundsRect.Top) then + include( fFlagsG2, G2_ChangedPos ); + {$ELSE} if Value.Left <> fBoundsRect.Left then fChangedPosSz := fChangedPosSz or 1; if Value.Top <> fBoundsRect.Top then fChangedPosSz := fChangedPosSz or 2; + {$ENDIF} {$IFDEF USE_GRAPHCTLS} - if not fWindowed then - Invalidate; + if {$IFDEF USE_FLAGS} (G6_GraphicCtl in fFlagsG6) + {$ELSE} not fWindowed {$ENDIF} then + Invalidate; {$ENDIF} fBoundsRect := Value; @@ -38212,42 +38661,48 @@ begin SetWindowPos( fHandle, 0, Rect.Left, Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, SWP_NOZORDER or SWP_NOACTIVATE ); end; - if fSizeRedraw then - Invalidate; + if {$IFDEF USE_FLAGS} (G1_SizeRedraw in fFlagsG1) + {$ELSE} fSizeRedraw {$ENDIF} then + Invalidate; end; {$ENDIF ASM_VERSION} {$ENDIF GDI} + {$IFDEF _X_} {$IFDEF GTK} -procedure TControl.SetBoundsRect( const Value: TRect ); -var Rect: TRect; +PROCEDURE TControl.SetBoundsRect( const Value: TRect ); +VAR Rect: TRect; window: PGtkWindow; -begin +BEGIN Rect := GetBoundsRect; if RectsEqual( Value, Rect ) then Exit; + {$IFDEF USE_FLAGS} + if (Value.Left <> fBoundsRect.Left) or (Value.Top <> fBoundsRect.Top) then + include( fFlagsG2, G2_ChangedPos ); + {$ELSE} if Value.Left <> fBoundsRect.Left then fChangedPosSz := fChangedPosSz or 1; if Value.Top <> fBoundsRect.Top then fChangedPosSz := fChangedPosSz or 2; + {$ENDIF} fBoundsRect := Value; Rect := Value; - if fIsControl then - begin - //gtk_widget_set_uposition( fHandle, Rect.Left, Rect.Top ); - if fParent <> nil then - fParent.fChildSetPos( fParent, @ Self, Rect.Left, Rect.Top ); - if (Rect.Right > Rect.Left) and (Rect.Bottom > Rect.Top) then - gtk_widget_set_size_request( fEventboxHandle, - Rect.Right - Rect.Left, Rect.Bottom - Rect.Top ); - end - else - begin - window := GTK_WINDOW( fHandle ); - gtk_window_move( window, Rect.Left, Rect.Top ); - gtk_window_resize( window, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top ); - end; + IF fIsControl then + BEGIN + //gtk_widget_set_uposition( fHandle, Rect.Left, Rect.Top ); + IF fParent <> nil then + fParent.fChildSetPos( fParent, @ Self, Rect.Left, Rect.Top ); + IF (Rect.Right > Rect.Left) and (Rect.Bottom > Rect.Top) then + gtk_widget_set_size_request( fEventboxHandle, + Rect.Right - Rect.Left, Rect.Bottom - Rect.Top ); + END ELSE + BEGIN + window := GTK_WINDOW( fHandle ); + gtk_window_move( window, Rect.Left, Rect.Top ); + gtk_window_resize( window, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top ); + END; //if fSizeRedraw then // Invalidate; -end; +END; {$ENDIF GTK} {$ENDIF _X_} @@ -38255,22 +38710,19 @@ end; const WindowStateShowCommands: array[TWindowState] of Byte = (SW_SHOWNOACTIVATE, SW_SHOWMINNOACTIVE, SW_SHOWMAXIMIZED); -//[procedure TControl.SetWindowState] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetWindowState( Value: TWindowState ); begin - if fWindowState <> Value then + if WindowState <> Value then begin - fWindowState := Value; - ShowWindow(GetWindowHandle, WindowStateShowCommands[Value]); + DF.fWindowState := Value; + if fHandle <> 0 then + ShowWindow(fHandle, WindowStateShowCommands[Value]); end; end; {$ENDIF ASM_VERSION} -//[procedure TControl.Show] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.Show; begin CreateWindow; @@ -38280,15 +38732,12 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.Hide] procedure TControl.Hide; begin SetVisible( False ); end; -//[function TControl.Client2Screen] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.Client2Screen( const P: TPoint ): TPoint; begin Result := P; @@ -38297,9 +38746,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.Screen2Client] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.Screen2Client( const P: TPoint ): TPoint; begin Result := P; @@ -38310,10 +38757,8 @@ end; {$ENDIF WIN_GDI} -//[function TControl.ClientRect] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.ClientRect: TRect; const BorderParams: array[ 0..5 ] of DWORD = ( SM_CXBORDER, SM_CXFRAME, SM_CXSIZEFRAME, SM_CYBORDER, SM_CYFRAME, SM_CYSIZEFRAME ); @@ -38331,26 +38776,24 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function TControl.ClientRect: TRect; //todo: implement exact, now for PaintBox only -begin +FUNCTION TControl.ClientRect: TRect; //todo: implement exact, now for PaintBox only +BEGIN Result := fBoundsRect; OffsetRect( Result, -Result.Left, -Result.Top ); Inc( Result.Top, fClientTop ); Dec( Result.Bottom, fClientBottom ); Inc( Result.Left, fClientLeft ); Dec( Result.Right, fClientRight ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[procedure TControl.Invalidate] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE PAS_VERSION} +{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} procedure TControl.Invalidate; begin {$IFDEF USE_GRAPHCTLS} - fDoInvalidate; + PP.fDoInvalidate( @Self ); {$ELSE} if fHandle <> 0 then InvalidateRect( fHandle, nil, TRUE ); @@ -38360,88 +38803,81 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TControl.Invalidate; -begin +PROCEDURE TControl.Invalidate; +BEGIN gtk_widget_queue_draw_area( fHandle, 0, 0, Width, Height ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} {$IFDEF USE_GRAPHCTLS} -procedure TControl.InvalidateNonWindowed; +procedure InvalidateNonWindowed( Sender: PObj ); var R: TRect; begin - R := BoundsRect; - if fParent.fHandle <> 0 then - InvalidateRect( fParent.fHandle, @ R, TRUE ); + R := PControl( Sender ).BoundsRect; + if PControl( Sender ).fParent.fHandle <> 0 then + InvalidateRect( PControl( Sender ).fParent.fHandle, @ R, TRUE ); end; -//[procedure TControl.InvalidateWindowed] -{$IFDEF ASM_VERSION} -{$ELSE PAS_VERSION} -procedure TControl.InvalidateWindowed; +{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} +procedure InvalidateWindowed( Sender: PObj ); begin - if fHandle <> 0 then - InvalidateRect( fHandle, nil, TRUE ); + if PControl( Sender ).fHandle <> 0 then + InvalidateRect( PControl( Sender ).fHandle, nil, TRUE ); end; {$ENDIF ASM_VERSION} {$ENDIF USE_GRAPHCTLS} -//[function TControl.GetIcon] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetIcon: HIcon; begin - Result := fIcon; - if Result = THandle( -1 ) then + Result := DF.fIcon; + if Result = THandle( -1 ) then begin - Result := 0; - Exit; + Result := 0; + Exit; end; - if Result = 0 then - if (Assigned( Applet )) and - (@Self <> Applet) then - begin - Result := Applet.Icon; - if Result <> 0 then - Result := CopyImage( Result, IMAGE_ICON, 0, 0, 0 ); - end - else - begin - {$IFDEF NUMERIC_APPICON} {$DEFINE CUSTOM_APPICON} {$ENDIF} - Result := LoadIcon( hInstance, - {$IFDEF CUSTOM_APPICON} {$IFDEF NUMERIC_APPICON} PKOLChar( {$ENDIF} // avoid A/W casting - {$I CustomAppIconRsrcName_PAS.inc} // create such file with 'your icon rsrc name' or yourIconID - {$IFDEF NUMERIC_APPICON} ) {$ENDIF} - {$ELSE} 'MAINICON' {$ENDIF} ); - end; - fIcon := Result; + if Result = 0 then + if (Applet <> nil) and (@Self <> Applet) then + begin + Result := Applet.Icon; + if Result <> 0 then + Result := CopyImage( Result, IMAGE_ICON, 0, 0, 0 ); + end + else + begin + {$IFDEF NUMERIC_APPICON} {$DEFINE CUSTOM_APPICON} {$ENDIF} + Result := LoadIcon( hInstance, + {$IFDEF CUSTOM_APPICON} {$IFDEF NUMERIC_APPICON} PKOLChar( {$ENDIF} // avoid A/W casting + {$I CustomAppIconRsrcName_PAS.inc} // create such file with 'your icon rsrc name' or yourIconID + {$IFDEF NUMERIC_APPICON} ) {$ENDIF} + {$ELSE} 'MAINICON' {$ENDIF} ); + end; + DF.fIcon := Result; end; {$ENDIF ASM_VERSION} -//* -//[procedure TControl.IconLoad] procedure TControl.IconLoad(Inst: Integer; ResName: PKOLChar); begin Icon := LoadIcon( Inst, ResName ); - fIconShared := TRUE; + {$IFDEF USE_FLAGS} include( fFlagsG1, G1_IconShared ); + {$ELSE} fIconShared := TRUE; {$ENDIF} end; -//[procedure TControl.IconLoadCursor] procedure TControl.IconLoadCursor(Inst: Integer; ResName: PKOLChar); begin Icon := LoadCursor( Inst, ResName ); - fIconShared := TRUE; + {$IFDEF USE_FLAGS} include( fFlagsG1, G1_IconShared ); + {$ELSE} fIconShared := TRUE; {$ENDIF} end; -//[function TControl.CallDefWndProc] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.CallDefWndProc(var Msg: TMsg): Integer; begin {$IFDEF INPACKAGE} + Result := 0; Log( '->TControl.CallDefWndProc FHandle = ' + Int2Str( FHandle ) + ', Msg.hwd = ' + Int2Str( Msg.hwnd ) ); TRY @@ -38453,7 +38889,8 @@ begin TRY TRY {$ENDIF INPACKAGE} - Result := CallWindowProc( FDefWndProc, FHandle, Msg.message, Msg.wParam, Msg.lParam ); + Result := CallWindowProc( + FDefWndProc, FHandle, Msg.message, Msg.wParam, Msg.lParam ); {$IFDEF INPACKAGE} EXCEPT on E: Exception do Log( '*** Exception in CallWindowProc, msg = ' + E.Message ); @@ -38479,12 +38916,10 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.GetWindowState] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetWindowState: TWindowState; begin - Result := fWindowState; + Result := DF.fWindowState; if Handle <> 0 then begin if IsIconic( Handle ) then @@ -38494,38 +38929,18 @@ begin Result := wsMaximized else Result := wsNormal; - fWindowState := Result; + //DF.fWindowState := Result; end; end; {$ENDIF ASM_VERSION} -//[function TControl.DoSetFocus] -{$IFDEF ASM_VERSION} -function TControl.DoSetFocus: Boolean; -asm - PUSH ESI - MOV ESI, EAX - - CALL GetEnabled - MOV DL, byte ptr [ESI+2].TControl.fStyle - OR DL, [ESI].TControl.fTabstop - //AND EDX, 1 - AND AL, DL - JZ @@exit - - INC [ESI].TControl.fClickDisabled - PUSH [ESI].TControl.fHandle - CALL SetFocus - DEC [ESI].TControl.fClickDisabled - MOV AL, 1 -@@exit: - POP ESI -end; -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.DoSetFocus: Boolean; begin Result := False; - if Enabled and (fTabstop or (fStyle and WS_TABSTOP <> 0)) then + if Enabled and ( + {$IFDEF USE_FLAGS}{$ELSE} fTabstop or {$ENDIF} + (F2_Tabstop in fStyle.f2_Style)) then begin Inc( fClickDisabled ); SetFocus( fHandle ); @@ -38535,28 +38950,22 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.HandleAllocated] function TControl.HandleAllocated: Boolean; begin Result := FHandle <> 0; end; -//[function TControl.GetEnabled] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetEnabled: Boolean; begin - if FHandle = 0 then - Result := (Style and WS_DISABLED) = 0 - else - Result := IsWindowEnabled( FHandle ); + if FHandle = 0 then + Result := (Style and WS_DISABLED) = 0 + else Result := IsWindowEnabled( FHandle ); end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[function TControl.IsMainWindow] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.IsMainWindow: Boolean; begin if Applet = nil then @@ -38569,7 +38978,6 @@ end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[function TControl.get_ClassName] {$IFDEF ASM_UNICODE} function TControl.get_ClassName: AnsiString; asm @@ -38583,7 +38991,11 @@ asm {$ENDIF} CALL System.@LStrFromPChar // EAX^ := String(EDX) POP EAX + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG6, 1 shl G6_CtlClassNameChg + {$ELSE} CMP [EBX].fCtlClsNameChg, 0 + {$ENDIF} JNZ @@exit MOV ECX, [EAX] MOV EDX, offset[ @@obj ] @@ -38602,29 +39014,25 @@ end; {$ELSE ASM_VERSION} //Pascal function TControl.get_ClassName: KOLString; begin -{ if not fCtlClsNameChg then - Result := KOLString('obj_') + fControlClassName - else - Result := fControlClassName; -} Result := fControlClassName; - if not fCtlClsNameChg then - Result := KOLString('obj_') + Result; + if {$IFDEF USE_FLAGS} not(G6_CtlClassNameChg in fFlagsG6) + {$ELSE} not fCtlClsNameChg {$ENDIF} then + Result := KOLString('obj_') + Result; end; {$ENDIF ASM_VERSION} -//[procedure TControl.set_ClassName] procedure TControl.set_ClassName(const Value: KOLString); begin - if fCtlClsNameChg then - FreeMem( fControlClassName ); + if {$IFDEF USE_FLAGS} G6_CtlClassNameChg in fFlagsG6 + {$ELSE} fCtlClsNameChg {$ENDIF} then + FreeMem( fControlClassName ); GetMem( fControlClassName, (Length( Value ) + 1) * Sizeof( KOLChar ) ); {$IFDEF UNICODE_CTRLS} WStrCopy {$ELSE} StrCopy {$ENDIF} ( fControlClassName, @ Value[ 1 ] ); - fCtlClsNameChg := TRUE; + {$IFDEF USE_FLAGS} include( fFlagsG6, G6_CtlClassNameChg ); + {$ELSE} fCtlClsNameChg := TRUE; {$ENDIF} end; -//[function WndProcQueryEndSession] function WndProcQueryEndSession( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Accept: Boolean; begin @@ -38634,14 +39042,16 @@ begin {$IFDEF DEBUG_ENDSESSION} LogFileOutput( GetStartDir + 'end_session.txt', '!' ); {$ENDIF} - if Assigned( Sender.fOnQueryEndSession ) then + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnQueryEndSession ) then + {$ENDIF} begin Accept := TRUE; - Sender.fCloseQueryReason := qShutdown; - if LongBool(Msg.lParam and {ENDSESSION_LOGOFF} DWORD($80000000)) then - Sender.fCloseQueryReason := qLogoff; - Sender.fOnQueryEndSession( Sender, Accept ); - Sender.fCloseQueryReason := qClose; + Sender.DF.fCloseQueryReason := qShutdown; + if LongBool(Msg.lParam and {ENDSESSION_LOGOFF} DWORD($80000000)) then + Sender.DF.fCloseQueryReason := qLogoff; + Sender.EV.fOnQueryEndSession( Sender, Accept ); + Sender.DF.fCloseQueryReason := qClose; Rslt := Integer( Accept ); // Добавить. Нужно для того, чтобы отменилось завершение сеанса, // если Accept установлен в False и сеанс завершился при Accept = True @@ -38652,41 +39062,44 @@ begin end; end; -//[procedure TControl.SetOnQueryEndSession] procedure TControl.SetOnQueryEndSession(const Value: TOnEventAccept); begin + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnQueryEndSession := Value; AttachProc( WndProcQueryEndSession ); - fOnQueryEndSession := Value; end; -//[function WndProcMinMaxRestore] function WndProcMinMaxRestore( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin Result := FALSE; if Msg.message = WM_SYSCOMMAND then begin case Msg.wParam and not 15 of - SC_MINIMIZE: if Assigned( Sender.fOnMinimize ) then - Sender.fOnMinimize( Sender ); - SC_MAXIMIZE: if Assigned( Sender.fOnMaximize ) then - Sender.fOnMaximize( Sender ); - SC_RESTORE: if Assigned( Sender.fOnRestore ) then - Sender.fOnRestore( Sender ); + SC_MINIMIZE: {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnMinimize ) then + {$ENDIF} + Sender.EV.fOnMinimize( Sender ); + SC_MAXIMIZE: {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnMaximize ) then + {$ENDIF} + Sender.EV.fOnMaximize( Sender ); + SC_RESTORE: {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnRestore ) then + {$ENDIF} + Sender.EV.fOnRestore( Sender ); end; end; end; -//[procedure TControl.SetOnMinMaxRestore] procedure TControl.SetOnMinMaxRestore(const Index: Integer; const Value: TOnEvent); type POnEvent = ^TOnEvent; {$IFDEF F_P} var Ptr1: Pointer; {$ELSE DELPHI} -var Ev: POnEvent; +var Evt: POnEvent; {$ENDIF F_P/DELPHI} begin - AttachProc( WndProcMinMaxRestore ); {$IFDEF F_P} Ptr1 := Self; asm @@ -38699,9 +39112,11 @@ begin MOV [EAX+4], EDX end [ 'EAX', 'EDX' ]; {$ELSE DELPHI} - Ev := Pointer( Integer( @ TMethod( fOnMinimize ).Code ) + Index ); - Ev^ := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents; {$ENDIF} + Evt := Pointer( Integer( @ TMethod( EV.fOnMinimize ).Code ) + Index ); + Evt^ := Value; {$ENDIF} + AttachProc( WndProcMinMaxRestore ); end; procedure TControl.SetOnMinimize(const Value: TOnEvent); @@ -38719,17 +39134,14 @@ begin SetOnMinMaxRestore( 16, Value ); end; -{$IFDEF F_P} -//[function TControl.GetOnMinMaxRestore] function TControl.GetOnMinMaxRestore(const Index: Integer): TOnEvent; begin CASE Index OF - 0: Result := fOnMinimize; - 8: Result := fOnMaximize; - 16: Result := fOnRestore; + 0: Result := EV.fOnMinimize; + 8: Result := EV.fOnMaximize; + 16: Result := EV.fOnRestore; END; end; -{$ENDIF F_P} {$IFDEF INPACKAGE} {$IFDEF ASM_LOCAL} @@ -38744,7 +39156,6 @@ end; {$ENDIF WIN_GDI} {$IFDEF GDI} -//[procedure TControl.SetParent] {$IFDEF ASM_LOCAL} {$ELSE ASM_VERSION} //Pascal procedure TControl.SetParent( Value: PControl ); @@ -38756,7 +39167,7 @@ begin Invalidate; // necessary for graphic controls {$ENDIF} {$IFDEF DEBUG_MCK} - if Assigned( fParent.fChildren ) then + if ( fParent.fChildren <> nil ) then begin mck_Log( 'remove from old parent children 1st' ); fParent.fChildren.Remove( @Self ); @@ -38769,8 +39180,10 @@ begin fParent.RemoveFromAutoFree( @Self ); {$ENDIF} - if Assigned( fParent.fNotifyChild ) then - fParent.fNotifyChild( fParent, nil ); + {$IFDEF NIL_EVENTS} + if Assigned( fParent.PP.fNotifyChild ) then + {$ENDIF} + fParent.PP.fNotifyChild( fParent, nil ); {$ENDIF not DEBUG_MCK} end; fParent := Value; @@ -38784,10 +39197,14 @@ begin if FHandle <> 0 then Windows.SetParent( FHandle, Value.GetWindowHandle ); {$ENDIF not INPACKAGE} //-------------------------------------------------- - if Assigned( fParent.fNotifyChild ) then - fParent.fNotifyChild( fParent, @ Self ); - if Assigned( fNotifyChild ) then - fNotifyChild( fParent, @ Self ); + {$IFDEF NIL_EVENTS} + if Assigned( fParent.PP.fNotifyChild ) then + {$ENDIF} + fParent.PP.fNotifyChild( fParent, @ Self ); + {$IFDEF NIL_EVENTS} + if Assigned( PP.fNotifyChild ) then + {$ENDIF} + PP.fNotifyChild( fParent, @ Self ); {$IFDEF USE_GRAPHCTLS} Invalidate; // necessary for graphic controls {$ENDIF} @@ -38797,40 +39214,37 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TControl.SetParent( Value: PControl ); -begin - if Value = fParent then Exit; - if fParent <> nil then +PROCEDURE TControl.SetParent( Value: PControl ); +BEGIN + IF Value = fParent THEN Exit; + IF fParent <> nil THEN begin - fParent.fChildren.Remove( @Self ); + fParent.fChildren.Remove( @Self ); - {$IFDEF NOT_USE_AUTOFREE4CONTROLS} - {$ELSE} - fParent.RemoveFromAutoFree( @Self ); - {$ENDIF} - end; + {$IFDEF NOT_USE_AUTOFREE4CONTROLS} + {$ELSE} + fParent.RemoveFromAutoFree( @Self ); + {$ENDIF} + END; fParent := Value; - if fParent <> nil then - begin + IF fParent <> nil THEN + BEGIN fParent.fChildren.Add( @Self ); {$IFDEF USE_AUTOFREE4CHILDREN} fParent.Add2AutoFree( @ Self ); {$ENDIF} - end; + END; fParent.fGetClientArea( fParent ); fParent.fChildPut( fParent, @ Self, fBoundsRect.Left, fBoundsRect.Top ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[function TControl.ChildIndex] function TControl.ChildIndex(Child: PControl): Integer; begin Result := fChildren.IndexOf( Child ); end; -//* -//[procedure TControl.MoveChild] procedure TControl.MoveChild(Child: PControl; NewIdx: Integer); var I: Integer; begin @@ -38840,7 +39254,6 @@ begin end; {$IFDEF WIN_GDI} -//[procedure TControl.EnableChildren] procedure TControl.EnableChildren(Enable, Recursive: Boolean); var I: Integer; C: PControl; @@ -38855,10 +39268,8 @@ begin end; {$ENDIF WIN_GDI} -//[constructor TControl.CreateParented] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal constructor TControl.CreateParented(AParent: PControl); begin InitParented( AParent ); // because InitParented is virtual, but CreateParented @@ -38867,12 +39278,12 @@ end; // can not be virtual (as an _object_ - not a class - {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -constructor TControl.CreateParented(AParent: PControl; widget: PGtkWidget; +CONSTRUCTOR TControl.CreateParented(AParent: PControl; widget: PGtkWidget; need_eventbox: Boolean); -begin +BEGIN InitParented( AParent, widget, need_eventbox ); // because InitParented is virtual, but CreateParented -end; // can not be virtual (as an _object_ - not a class - constructor) +END; // can not be virtual (as an _object_ - not a class - constructor) {$ENDIF GTK} {$ENDIF _X_} @@ -38881,18 +39292,14 @@ begin InitOrthaned( AParentWnd ); end; -//[function TControl.GetLeft] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetLeft: Integer; begin Result := BoundsRect.Left; end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetLeft] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetLeft( Value: Integer ); var R: TRect; begin @@ -38903,18 +39310,14 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.GetTop] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetTop: Integer; begin Result := BoundsRect.Top; end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetTop] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetTop( Value: Integer ); var R: TRect; begin @@ -38925,9 +39328,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.GetWidth] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetWidth: Integer; begin with BoundsRect do @@ -38935,9 +39336,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetWidth] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetWidth( Value: Integer ); var R: TRect; begin @@ -38948,9 +39347,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.GetHeight] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetHeight: Integer; begin with BoundsRect do @@ -38958,9 +39355,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetHeight] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetHeight( Value: Integer ); var R: TRect; begin @@ -38971,9 +39366,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.GetPosition] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetPosition: TPoint; begin Result.x := BoundsRect.Left; @@ -38981,9 +39374,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.Set_Position] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.Set_Position( Value: TPoint ); var R: TRect; begin @@ -38996,7 +39387,6 @@ end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[function WndProcConstraints] function WndProcConstraints( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var MMI: PMinMaxInfo; begin @@ -39027,8 +39417,7 @@ end; {$UNDEF implementation} {$ENDIF} -//[procedure TControl.SetConstraint] -procedure TControl.SetConstraint(const Index, Value: Integer); +procedure TControl.SetConstraint(const Index: Integer; Value: SmallInt); begin AttachProc( WndProcConstraints ); case Index of @@ -39039,21 +39428,16 @@ begin end; end; -{$IFDEF F_P} -//[function TControl.GetConstraint] function TControl.GetConstraint(const Index: Integer): Integer; begin CASE Index OF - 0: Result := FMinWidth; - 1: Result := FMinHeight; - 2: Result := FMaxWidth; - 3: Result := FMaxHeight; + 0: Result := FMinWidth; + 1: Result := FMinHeight; + 2: Result := FMaxWidth; + else Result := FMaxHeight; END; end; -{$ENDIF F_P} -//* -//[function TControl.ControlRect] function TControl.ControlRect: TRect; var C: PControl; R: TRect; @@ -39062,13 +39446,14 @@ begin C := Parent; if C <> nil then begin - if not C.fIsControl then Exit; + if {$IFDEF USE_FLAGS} not(G3_IsControl in C.fFlagsG3) + {$ELSE} not C.fIsControl {$ENDIF} then Exit; R := C.ControlRect; OffsetRect( Result, R.Left, R.Top ); if C.fChildren <> nil then - if C.FChildren.IndexOf( @Self ) >= C.MembersCount then + if C.FChildren.IndexOf( @Self ) >= 0 then begin R := C.ClientRect; Dec( R.Top, C.fClientTop ); @@ -39078,8 +39463,6 @@ begin end; end; -//* -//[function TControl.ControlAtPos] function TControl.ControlAtPos( X, Y: Integer; IgnoreDisabled: Boolean ): PControl; var I: Integer; C: PControl; @@ -39087,10 +39470,11 @@ var I: Integer; begin Result := nil; CR := ControlRect; // относительные координаты в системе РОДИТЕЛЬСКОГО КОНТРОЛА - if Windowed then CR := MakeRect( 0, 0, 0, 0 ); + if {$IFDEF USE_FLAGS} not(G6_GraphicCtl in fFlagsG6) + {$ELSE} fWindowed {$ENDIF} then CR := MakeRect( 0, 0, 0, 0 ); X := X + CR.Left; // - R.Left; Y := Y + CR.Top; // - R.Top; - for I := ChildCount { + MembersCount } - 1 downto 0 do + for I := ChildCount - 1 downto 0 do begin C := Children[ I ]; //Members[ I ]; if C.Visible then @@ -39108,9 +39492,7 @@ begin end; {$ENDIF WIN_GDI} -//[PROCEDURE DefaultPaintBackground] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure DefaultPaintBackground( Sender: PControl; DC: HDC; Rect: PRect ); {$IFDEF GDI} var B: HBrush; {$ENDIF GDI} begin @@ -39121,20 +39503,16 @@ begin {$ENDIF GDI} end; {$ENDIF ASM_VERSION} -//[END DefaultPaintBackground] {$IFDEF WIN_GDI} -//[procedure TControl.PaintBackground] procedure TControl.PaintBackground( DC: HDC; Rect: PRect ); begin Global_OnPaintBkgnd( @Self, DC, Rect ); end; {$ENDIF WIN_GDI} -//[procedure TControl.SetCtlColor] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetCtlColor( Value: TColor ); begin {$IFNDEF INPACKAGE} @@ -39146,10 +39524,10 @@ begin Perform( fCommandActions.aSetBkColor, 0, Color2RGB( Value ) ); if fColor = Value then Exit; fColor := Value; - if fTmpBrush <> 0 then + if fTmpBrush <> 0 then begin - DeleteObject( fTmpBrush ); - fTmpBrush := 0; + DeleteObject( fTmpBrush ); + fTmpBrush := 0; end; if fBrush <> nil then fBrush.Color := Value; @@ -39159,20 +39537,20 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TControl.SetCtlColor( Value: TColor ); -var gcolor: TGdkColor; +PROCEDURE TControl.SetCtlColor( Value: TColor ); +VAR gcolor: TGdkColor; i: Integer; -begin +BEGIN if fColor = Value then Exit; fColor := Value; //oldfontdesc := PGtkWidget( _Self.fHandle ).style.font_desc; gcolor := Color2GdkColor( Value ); - for i := 0 to 4 do - begin + FOR i := 0 to 4 do + BEGIN gtk_widget_modify_bg( fEventboxHandle, {GTK_STATE_NORMAL} i, @ gcolor ); gtk_widget_modify_base( fEventboxHandle, {GTK_STATE_NORMAL} i, @ gcolor ); - end; + END; //if Assigned( _Self.fFont ) then {begin _Self.fHandle.style.font_desc := @@ -39182,14 +39560,12 @@ begin end;} //Invalidate; -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -//[function TControl.GetParentWnd] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetParentWnd( NeedHandle: Boolean ): HWnd; var C: PControl; begin @@ -39204,9 +39580,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.CreateChildWindows] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.CreateChildWindows; var I: Integer; C: PControl; @@ -39233,7 +39607,6 @@ end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[function TControl.GetMembers] function TControl.GetMembers(Idx: Integer): PControl; begin Result := fChildren.Items[ Idx ]; @@ -39241,7 +39614,6 @@ begin end; {$IFDEF WIN_GDI} -//[procedure TControl.DestroyChildren] {$IFDEF ASM_TLIST} procedure TControl.DestroyChildren; asm @@ -39284,16 +39656,7 @@ begin end; {$ENDIF ASM_VERSION} -{//- -//[function TControl.WindowedParent] -function TControl.WindowedParent: PControl; -begin - Result := fParent; -end;} - -//[function TControl.ProcessMessage] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.ProcessMessage: Boolean; var Msg: TMsg; begin @@ -39310,7 +39673,9 @@ begin end else begin - if not(Assigned( fExMsgProc ) and fExMsgProc( @Self, Msg )) then + if not( + {$IFDEF NIL_EVENTS} Assigned( PP.fExMsgProc ) and {$ENDIF} + PP.fExMsgProc( @Self, Msg )) then begin TranslateMessage( Msg ); DispatchMessage( Msg ); @@ -39324,16 +39689,13 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.ProcessMessages] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.ProcessMessages; begin while ProcessMessage do ; end; {$ENDIF ASM_VERSION} -//[procedure TControl.ProcessMessagesEx] procedure TControl.ProcessMessagesEx; begin PostMessage( GetWindowHandle, CM_PROCESS, 0, 0 ); @@ -39341,7 +39703,6 @@ begin end; //- -//[procedure TControl.ProcessPendingMessages] procedure TControl.ProcessPendingMessages; var Msg: TMsg; begin @@ -39352,7 +39713,6 @@ begin Applet.ProcessMessages; end; -//[procedure TControl.ProcessPaintMessages] procedure TControl.ProcessPaintMessages; var Msg: TMsg; begin @@ -39360,89 +39720,13 @@ begin Applet.ProcessMessage; end; -//[FUNCTION WndProcForm] -{$IFDEF ASM_VERSION} -function WndProcForm(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; -const szPaintStruct = sizeof(TPaintStruct); -asm //cmd //opd - {$IFDEF ENDSESSION_HALT} - CMP word ptr [EDX].TMsg.message, WM_ENDSESSION - JNE @@chk_WM_SETFOCUS - - CMP [EDX].TMsg.wParam, 0 - JZ @@ret_false - - CALL TObj.RefDec - XOR EAX, EAX - MOV [AppletRunning], AL - XCHG EAX, [Applet] - INC [AppletTerminated] - - CALL TObj.RefDec - CALL System.@Halt0 - {$ENDIF ENDSESSION_HALT} - -@@chk_WM_SETFOCUS: - CMP word ptr [EDX].TMsg.message, WM_SETFOCUS - JNE @@ret_false - - PUSH EBX - PUSH ESI - XOR EBX, EBX - INC EBX - XCHG ESI, EAX - {$IFDEF NEW_MODAL} - MOV ECX, [ESI].TControl.fModalForm - JECXZ @@no_fix_modal_setfocus - PUSH [ECX].TControl.fHandle - CALL SetFocus -@@no_fix_modal_setfocus: - MOV ECX, [ESI].TControl.FCurrentControl - JECXZ @@setFocuswhenCreateWindow - MOV DL, [ECX].TControl.fIsForm - XOR DL, [ESI].TControl.FIsApplet - JNZ @@1 - {$ELSE not NEW_MODAL} - MOV ECX, [ESI].TControl.FCurrentControl - JECXZ @@0 - {$ENDIF} -@@setFocuswhenCreateWindow: - //INC EBX - XCHG EAX, ECX - - // or CreateForm? - PUSH EAX - CALL CallTControlCreateWindow - TEST AL, AL - POP EAX - JZ @@1 - - PUSH [EAX].TControl.fHandle - CALL SetFocus - INC EBX -@@0: DEC EBX -@@1: MOV ECX, [Applet] - JECXZ @@ret_EBX - CMP ECX, ESI - JE @@ret_EBX - MOV [ECX].TControl.FCurrentControl, ESI -@@ret_EBX: - XCHG EAX, EBX - POP ESI - POP EBX - RET - -@@ret_false: - XOR EAX, EAX -end; -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProcForm(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; {$IFDEF ENDSESSION_HALT} var App: PControl; {$ENDIF} begin Result := True; - //with Self_{-}^{+} do case Msg.message of {$IFDEF ENDSESSION_HALT} WM_ENDSESSION: @@ -39474,21 +39758,24 @@ begin WM_SETFOCUS: begin {$IFDEF NEW_MODAL} - if fModalForm <> nil then - SetFocus( fModalForm.fHandle ) - else if ( FCurrentControl <> nil ) and - not ( fCurrentControl.IsForm xor fIsApplet ) then + if Self_.DF.fModalForm <> nil then + SetFocus( Self_.DF.fModalForm.fHandle ) + else if ( Self_.DF.FCurrentControl <> nil ) and + {$IFDEF USE_FLAGS} not( (G3_IsForm in Self_.DF.fCurrentControl.fFlagsG3) + xor(G3_IsApplet in Self_.fFlagsG3) ) + {$ELSE} not(Self_.DF.FCurrentControl.fIsForm xor Self_.fIsApplet) + {$ENDIF} then {$ELSE not NEW_MODAL} - if Self_.FCurrentControl <> nil then + if Self_.DF.FCurrentControl <> nil then {$ENDIF} begin - if Self_.FCurrentControl.CreateWindow then - SetFocus( Self_.FCurrentControl.fHandle ); + if Self_.DF.FCurrentControl.CreateWindow then + SetFocus( Self_.DF.FCurrentControl.fHandle ); end else Result := False; if assigned( Applet ) and (Applet <> Self_) then - Applet.FCurrentControl := Self_; + Applet.DF.FCurrentControl := Self_; end; {$IFDEF SNAPMOUSE2DFLTBTN} //WM_INITDIALOG: @@ -39498,12 +39785,9 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END WndProcForm] {$ENDIF WIN_GDI} -//[FUNCTION GetPrevCtrlBoundsRect] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function GetPrevCtrlBoundsRect( P: PControl; var R: TRect ): Boolean; var Idx: Integer; begin @@ -39515,11 +39799,8 @@ begin R := P.FParent.Children[ Idx ].BoundsRect; end; {$ENDIF ASM_VERSION} -//[END GetPrevCtrlBoundsRect] -//[function TControl.PlaceUnder] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.PlaceUnder: PControl; var R: TRect; begin @@ -39530,9 +39811,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.PlaceDown] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.PlaceDown: PControl; var R: TRect; begin @@ -39542,9 +39821,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.PlaceRight] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.PlaceRight: PControl; var R: TRect; begin @@ -39555,9 +39832,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.SetSize] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.SetSize(W, H: Integer): PControl; var R: TRect; begin @@ -39570,7 +39845,6 @@ end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[function TControl.SetClientSize] function TControl.SetClientSize(W, H: Integer): PControl; begin if W > 0 then ClientWidth := W; @@ -39578,9 +39852,7 @@ begin Result := @Self; end; -//[function TControl.AlignLeft] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.AlignLeft(P: PControl): PControl; begin Result := @Self; @@ -39588,9 +39860,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.AlignTop] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.AlignTop(P: PControl): PControl; begin Result := @Self; @@ -39607,247 +39877,28 @@ end; {$ENDIF} {$ENDIF} -//[FUNCTION WndProcCtrl] {$IFDEF ASM_VERSION} // see addition for combobox in pas version -function WndProcCtrl( Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; -asm //cmd //opd - PUSH EBX - XCHG EBX, EAX - PUSH ESI - PUSH EDI - MOV EDI, EDX - MOV EDX, [EDI].TMsg.message - - SUB DX, CN_CTLCOLORMSGBOX - CMP DX, CN_CTLCOLORSTATIC-CN_CTLCOLORMSGBOX - JA @@chk_CM_COMMAND -@@2: - PUSH ECX - MOV EAX, [EBX].TControl.fTextColor - CALL Color2RGB - XCHG ESI, EAX - PUSH ESI - PUSH [EDI].TMsg.wParam - CALL SetTextColor - CMP [EBX].TControl.fTransparent, 0 - JZ @@opaque - - PUSH Windows.TRANSPARENT - PUSH [EDI].TMsg.wParam - CALL SetBkMode - PUSH NULL_BRUSH - CALL GetStockObject - JMP @@ret_rslt - -@@opaque: - MOV EAX, [EBX].TControl.fColor - CALL Color2RGB - XCHG ESI, EAX - PUSH OPAQUE - PUSH [EDI].TMsg.wParam - CALL SetBkMode - PUSH ESI - PUSH [EDI].TMsg.wParam - CALL SetBkColor - - MOV EAX, EBX - CALL Global_GetCtlBrushHandle -@@ret_rslt: - XCHG ECX, EAX -@@tmpbrushready: - POP EAX - MOV [EAX], ECX -@@ret_true: - MOV AL, 1 - - JMP @@ret_EAX - -@@chk_CM_COMMAND: - CMP word ptr [EDI].TMsg.message, CM_COMMAND - JNE @@chk_WM_SETFOCUS - - PUSH ECX - - MOVZX ECX, word ptr [EDI].TMsg.wParam+2 - CMP CX, [EBX].TControl.fCommandActions.aClick - JNE @@chk_aEnter - - CMP [EBX].TControl.fClickDisabled, 0 - JG @@calldef - MOV EAX, EBX - MOV DL, 1 - CALL TControl.SetFocused - MOV EAX, EBX - CALL TControl.DoClick - JMP @@calldef - -@@chk_aEnter: - LEA EAX, [EBX].TControl.fOnEnter - CMP CX, [EBX].TControl.fCommandActions.aEnter - JE @@goEvent - LEA EAX, [EBX].TControl.fOnLeave - CMP CX, [EBX].TControl.fCommandActions.aLeave - JE @@goEvent - LEA EAX, [EBX].TControl.fOnChange - CMP CX, [EBX].TControl.fCommandActions.aChange - JNE @@chk_aSelChange -@@goEvent: - MOV ECX, [EAX].TMethod.Code - JECXZ @@2calldef - MOV EAX, [EAX].TMethod.Data - MOV EDX, EBX - CALL ECX -@@2calldef: - JMP @@calldef - -@@chk_aSelChange: - CMP CX, [EBX].TControl.fCommandActions.aSelChange - JNE @@chk_WM_SETFOCUS_1 - MOV EAX, EBX - CALL TControl.DoSelChange - -@@calldef: - XCHG EAX, EBX - MOV EDX, EDI - CALL TControl.CallDefWndProc - JMP @@ret_rslt - -@@chk_WM_SETFOCUS_1: - POP ECX -@@chk_WM_SETFOCUS: - XOR EAX, EAX - CMP word ptr [EDI].TMsg.message, WM_SETFOCUS - JNE @@chk_WM_KEYDOWN - - MOV [ECX], EAX - MOV EAX, EBX - CALL TControl.ParentForm - TEST EAX, EAX - JZ @@ret_true - - PUSH EAX - MOV ECX, [EAX].TControl.FCurrentControl - JECXZ @@a1 - CMP ECX, EBX - JZ @@a1 - XCHG EAX, ECX - MOV ECX, [EAX].TControl.fLeave.TMethod.Code - JECXZ @@a1 - XCHG EDX, EAX - MOV EAX, [EDX].TControl.fLeave.TMethod.Data - CALL ECX -@@a1: POP EAX - - MOV [EAX].TControl.FCurrentControl, EBX - XOR EAX, EAX - - PUSH EDX -@@2ret_EAX: - POP EDX - -@@chk_WM_KEYDOWN: - {$IFDEF KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS} - CMP word ptr [EDI].TMsg.message, WM_KEYDOWN - {$IFDEF KEY_PREVIEW} - JNE @@chk_other_KEYMSGS - {$ELSE} - JNE @@ret0 - {$ENDIF} - - {$IFDEF KEY_PREVIEW} - MOV EAX, EBX - CALL TControl.ParentForm - CMP EAX, EBX - JE @@kp_end - - CMP [EAX].TControl.fKeyPreview, 0 - JZ @@kp_end - - MOV [EAX].TControl.fKeyPreviewing, 1 - INC [EAX].TControl.fKeyPreviewCount - PUSH EAX - - PUSH [EDI].TMsg.lParam - PUSH [EDI].TMsg.wParam - PUSH WM_KEYDOWN - PUSH EAX - CALL TControl.Perform - POP EAX - DEC [EAX].TControl.fKeyPreviewCount -@@kp_end: - {$ENDIF} - - {$IFDEF ESC_CLOSE_DIALOGS} - MOV EAX, EBX - CALL TControl.ParentForm - TEST [EAX].TControl.fExStyle, WS_EX_DLGMODALFRAME - JZ @@ecd_end - CMP [EDI].TMsg.wParam, 27 - JNE @@ecd_end - PUSH 0 - PUSH 0 - PUSH WM_CLOSE - PUSH EAX - CALL TControl.Perform -@@ecd_end: - {$ENDIF} - -@@ret0: - XOR EAX, EAX - {$IFDEF KEY_PREVIEW} - JMP @@ret_EAX -@@chk_other_KEYMSGS: - MOVZX EAX, word ptr [EDI].TMsg.message - SUB AX, WM_KEYDOWN - JB @@ret0 - CMP AX, 6 - JA @@ret0 - // all WM_KEYUP=$101, WM_CHAR=$102, WM_DEADCHAR=$103, WM_SYSKEYDOWN=$104, - // WM_SYSKEYUP=$105, WM_SYSCHAR=$106, WM_SYSDEADCHAR=$107 - MOV EAX, EBX - CALL TControl.ParentForm - CMP EAX, EBX - JE @@ret0 - MOV [EAX].TControl.fKeyPreviewing, 1 - INC [EAX].TControl.fKeyPreviewCount - PUSH EAX - PUSH [EDI].TMsg.lParam - PUSH [EDI].TMsg.wParam - PUSH [EDI].TMsg.message - PUSH EAX - CALL TControl.Perform - POP EAX - DEC [EAX].TControl.fKeyPreviewCount - XOR EAX, EAX - {$ENDIF KEY_PREVIEW} - {$ENDIF KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS} - -@@ret_EAX: - POP EDI - POP ESI - POP EBX -end; {$ELSE ASM_VERSION} //Pascal function WndProcCtrl(Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; var F: PControl; Cmd : DWORD; begin Result := FALSE; - with Self_{-}^{+} do + with Self_^ do case Msg.message of CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC: begin SetTextColor(Msg.WParam, Color2RGB(fTextColor)); - if fTransparent then + if {$IFDEF USE_FLAGS} G2_Transparent in fFlagsG2 + {$ELSE} fTransparent {$ENDIF} then begin - SetBkMode( Msg.wParam, Windows.TRANSPARENT ); - Rslt := GetStockObject( NULL_BRUSH ); - end - else + SetBkMode( Msg.wParam, Windows.TRANSPARENT ); + Rslt := GetStockObject( NULL_BRUSH ); + end else begin - SetBkMode( Msg.wParam, Windows.OPAQUE ); - SetBkColor(Msg.WParam, Color2RGB( fColor ) ); - Rslt := Global_GetCtlBrushHandle( Self_ ); + SetBkMode( Msg.wParam, Windows.OPAQUE ); + SetBkColor(Msg.WParam, Color2RGB( fColor ) ); + Rslt := Global_GetCtlBrushHandle( Self_ ); end; Result := TRUE; end; @@ -39865,15 +39916,15 @@ begin end else if Cmd = fCommandActions.aEnter then begin - if Assigned( fOnEnter ) then fOnEnter( Self_ ); + if Assigned( EV.fOnEnter ) then EV.fOnEnter( Self_ ); end else if Cmd = fCommandActions.aLeave then begin - if Assigned( fOnLeave ) then fOnLeave( Self_ ); + if Assigned( EV.fOnLeave ) then EV.fOnLeave( Self_ ); end else if Integer(Cmd) = fCommandActions.aChange then begin - if Assigned( fOnChange ) then fOnChange( Self_ ); + if Assigned( EV.fOnChange ) then EV.fOnChange( Self_ ); end else if Integer(Cmd) = fCommandActions.aSelChange then begin @@ -39893,10 +39944,13 @@ begin F := ParentForm; if F <> nil then begin - if (F.fCurrentControl <> nil) and (F.fCurrentControl <> Self_) and - Assigned( F.fCurrentControl.fLeave ) then - F.fCurrentControl.fLeave( F.fCurrentControl ); - F.fCurrentControl := Self_; + if (F.DF.fCurrentControl <> nil) and (F.DF.fCurrentControl <> Self_) + {$IFDEF NIL_EVENTS} + and Assigned( F.DF.fCurrentControl.EV.fLeave ) + {$ENDIF} + then + F.DF.fCurrentControl.EV.fLeave( F.DF.fCurrentControl ); + F.DF.fCurrentControl := Self_; Result := False; // go further handling end; end; @@ -39907,11 +39961,15 @@ begin //--------------------------------Truf------------------------------------- if ParentForm <> Self_ then begin - if ParentForm.KeyPreview then begin - ParentForm.KeyPreviewing := TRUE; - inc( ParentForm.FKeyPreviewCount ); - ParentForm.Perform(WM_KEYDOWN,msg.wParam,msg.lParam); - dec( ParentForm.FKeyPreviewCount ); + if {$IFDEF USE_FLAGS} G6_KeyPreview in ParentForm.fFlagsG6 + {$ELSE} ParentForm.fKeyPreview {$ENDIF} then + begin + {$IFDEF USE_FLAGS} + include( ParentForm.fFlagsG4, G4_Pushed ); + {$ELSE} ParentForm.fKeyPreviewing := TRUE; {$ENDIF} + inc( ParentForm.DF.fKeyPreviewCount ); + ParentForm.Perform(WM_KEYDOWN,msg.wParam,msg.lParam); + dec( ParentForm.DF.fKeyPreviewCount ); end; end; //--------------------------------Truf------------------------------------- @@ -39919,9 +39977,9 @@ begin {$IFDEF ESC_CLOSE_DIALOGS} //---------------------------------Babenko Alexey-------------------------- begin - if (Self_.ParentForm.fExStyle and WS_EX_DLGMODALFRAME) <> 0 then - if Msg.wParam = 27 then - Self_.ParentForm.Perform(WM_CLOSE, 0, 0); + if (Self_.ParentForm.fExStyle and WS_EX_DLGMODALFRAME) <> 0 then + if Msg.wParam = 27 then + Self_.ParentForm.Perform(WM_CLOSE, 0, 0); end; //---------------------------------Babenko Alexey-------------------------- {$ENDIF ESC_CLOSE_DIALOGS} @@ -39932,10 +39990,13 @@ begin WM_CHAR, WM_SYSCHAR: if ParentForm <> Self_ then begin - if ParentForm.KeyPreview then + if {$IFDEF USE_FLAGS} G6_KeyPreview in ParentForm.fFlagsG6 + {$ELSE} ParentForm.fKeyPreview {$ENDIF} then begin - ParentForm.KeyPreviewing := TRUE; - ParentForm.Perform(Msg.message,msg.wParam,msg.lParam); + {$IFDEF USE_FLAGS} + include( ParentForm.fFlagsG4, G4_Pushed ); + {$ELSE} ParentForm.fKeyPreviewing := TRUE; {$ENDIF} + ParentForm.Perform(Msg.message,msg.wParam,msg.lParam); end; end; {$ENDIF KEY_PREVIEW} @@ -39943,9 +40004,7 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END WndProcCtrl] -//[FUNCTION WndProcTransparent] {$IFDEF OLD_TRANSPARENT} function WndProcTransparent( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; @@ -39975,7 +40034,8 @@ begin end; WM_SETTEXT: begin - if Sender.fIsStaticControl = 0 then exit; + if {$IFDEF USE_FLAGS} not(G1_IsStaticControl in Sender.fFlagsG1) + {$ELSE} Sender.fIsStaticControl = 0 {$ENDIF} then exit; Sender.Invalidate; Rslt := DefWindowProc ( Sender.fHandle, WM_SETTEXT, Msg.wParam, Msg.lParam ); @@ -39990,10 +40050,13 @@ begin end; end; - if Sender.fTransparent and (not Sender.fParent.fDoubleBuffered) then + if Sender.fTransparent and ( + {$IFDEF USE_FLAGS} not(G2_DoubleBuffered in Sender.FParent.fFlagsG2) + {$ELSE} not Sender.fParent.fDoubleBuffered {$ENDIF} ) then Sender.fTransparent := FALSE; - if not (Sender.fTransparent or Sender.fDoubleBuffered) then exit; - if Sender.fSelfRequirePaint then exit; + if {$IFDEF USE_FLAGS} [G2_DoubleBuffered, G2_Transparent] * Sender.fFlagsG2 = [] + {$ELSE} not (Sender.fTransparent or Sender.fDoubleBuffered) {$ENDIF} then exit; + if Sender.fAnchors and SELF_REQ_PAINT <> 0 then exit; case Msg.message of WM_ERASEBKGND: @@ -40003,7 +40066,9 @@ begin WM_PAINT: begin ValidateRect(Sender.fHandle, nil); //???--brandys??? - if (Sender.fTransparent) and (not Sender.fParentRequirePaint) then begin + if (Sender.fTransparent) + and (Sender.fAnchors and PARENT_REQ_PAINT = 0) then + begin InvalidateRect(Sender.fParent.Handle, nil, FALSE); Result := TRUE; exit; @@ -40011,7 +40076,8 @@ begin GetClientRect(Msg.hwnd, Margins); OLDp := 0; - if not Sender.fParentRequirePaint then begin + if Sender.fAnchors and PARENT_REQ_PAINT = 0 then + begin Sender.fDblExcludeRgn := CreateRectRgn(0, 0, Margins.Right, Margins.Bottom); DC := GetDC(0); PDC := CreateCompatibleDC( DC ); @@ -40025,9 +40091,11 @@ begin Sender.fDblExcludeRgn := Sender.fParent.fDblExcludeRgn; end; - Sender.fSelfRequirePaint := TRUE; + Sender.fAnchors := Sender.fAnchors or SELF_REQ_PAINT; Sender.fPaintDC := PDC; - if (not Sender.fParentRequirePaint) or Sender.fDoubleBuffered then + if (Sender.fAnchors and PARENT_REQ_PAINT = 0) or + {$IFDEF USE_FLAGS} G2_DoubleBuffered in Sender.fFlagsG2 + {$ELSE} Sender.fDoubleBuffered {$ENDIF} then Sender.Perform(WM_ERASEBKGND, PDC, 0); Sender.Perform(WM_PAINT, PDC, 0); @@ -40040,11 +40108,14 @@ begin {$ELSE} C := Pointer( GetWindowLong( Wnd, GWL_USERDATA ) ); {$ENDIF} - with C{-}^{+} do begin - if (C <> nil) and (fTransparent or fDoubleBuffered) then begin + with C^ do begin + if (C <> nil) and + {$IFDEF USE_FLAGS} ( [G2_DoubleBuffered, G2_Transparent] + * fFlagsG2 <> [] ) + {$ELSE} (fTransparent or fDoubleBuffered) {$ENDIF} then + begin Save := SaveDC( PDC ); - fParentRequirePaint := TRUE; - + Include( fAnchors, PARENT_REQ_PAINT ); L := Sender.fParentCoordX + Left; T := Sender.fParentCoordY + Top; SetWindowOrgEx(PDC, -L, -T, nil); @@ -40058,10 +40129,10 @@ begin GetClientRect(Wnd, TR); IntersectClipRect(PDC, 0, 0, TR.Right, TR.Bottom); SendMessage(Wnd, WM_PAINT, PDC, 0); - - fParentRequirePaint := FALSE; + Exclude( fAnchors, PARENT_REQ_PAINT ); RestoreDC( PDC, Save ); - end else begin + end else + begin GetWindowRect(Wnd, TR); TP.X := 0; TP.Y := 0; ClientToScreen(Sender.fHandle, TP); @@ -40079,9 +40150,10 @@ begin Wnd := GetWindow( Wnd, GW_HWNDPREV ); end; Sender.fPaintDC := 0; - Sender.fSelfRequirePaint := FALSE; + Sender.fAnchors := Sender.fAnchors and not SELF_REQ_PAINT; - if not Sender.fParentRequirePaint then begin + if Sender.fAnchors and PARENT_REQ_PAINT = 0 then + begin BLTDC := GetWindowDC(Sender.fHandle); GetWindowRect( Sender.fHandle, TR ); ParentClient.x := 0; ParentClient.y := 0; @@ -40133,9 +40205,14 @@ begin end; {$ENDIF} - if Sender.fTransparent and (not Sender.fParent.fDoubleBuffered) then - Sender.fTransparent := FALSE; - if not (Sender.fTransparent or Sender.fDoubleBuffered) then exit; + if {$IFDEF USE_FLAGS} (G2_Transparent in Sender.fFlagsG2) + {$ELSE} Sender.fTransparent {$ENDIF} and ( + {$IFDEF USE_FLAGS} not(G2_DoubleBuffered in Sender.FParent.fFlagsG2) + {$ELSE} not Sender.fParent.fDoubleBuffered {$ENDIF} ) then + {$IFDEF USE_FLAGS} exclude( Sender.fFlagsG2, G2_Transparent ); + {$ELSE} Sender.fTransparent := FALSE; {$ENDIF} + if {$IFDEF USE_FLAGS} [G2_DoubleBuffered, G2_Transparent] * Sender.fFlagsG2 = [] + {$ELSE} not (Sender.fTransparent or Sender.fDoubleBuffered) {$ENDIF} then exit; case Msg.message of WM_HSCROLL, WM_VSCROLL: @@ -40145,7 +40222,8 @@ begin end; WM_SETTEXT: begin - if Sender.fIsStaticControl = 0 then exit; + if {$IFDEF USE_FLAGS} not(G1_IsStaticControl in Sender.fFlagsG1) + {$ELSE} Sender.fIsStaticControl = 0 {$ENDIF} then exit; Sender.Invalidate; Rslt := DefWindowProc ( Sender.fHandle, WM_SETTEXT, Msg.wParam, Msg.lParam ); Result := TRUE; @@ -40154,23 +40232,21 @@ begin WM_PAINT, WM_ERASEBKGND:; WM_NCPAINT: - if not Sender.fTransparent then - exit; + if {$IFDEF USE_FLAGS} not(G2_Transparent in Sender.fFlagsG2) + {$ELSE} not Sender.fTransparent {$ENDIF} then + exit; else exit; end; - if Sender.fSelfRequirePaint then begin - exit; - end; - + if Sender.fAnchors and SELF_REQ_PAINT <> 0 then exit; Result := TRUE; - //if Sender.fTransparent and (not Sender.fParentRequirePaint) then - {if (Sender.fTransparent or - Sender.fDoubleBuffered) and (Sender.FParent <> nil)} // было - if Assigned(Sender.fParent) and (not Sender.isForm) // стало - and Sender.FParent.fDoubleBuffered - and (not Sender.fParentRequirePaint) then + if Assigned(Sender.fParent) + and {$IFDEF USE_FLAGS} not(G3_IsForm in Sender.fFlagsG3) + {$ELSE} (not Sender.fIsForm) {$ENDIF} + and {$IFDEF USE_FLAGS} (G2_DoubleBuffered in Sender.FParent.fFlagsG2) + {$ELSE} Sender.FParent.fDoubleBuffered {$ENDIF} + and (Sender.fAnchors and PARENT_REQ_PAINT = 0) then begin TR := Sender.BoundsRect; InvalidateRect(Sender.fParent.fHandle, @TR, true); @@ -40180,29 +40256,33 @@ begin if Msg.message = WM_PAINT then begin OLDp := 0; - if not Sender.fParentRequirePaint then begin - Sender.fDblExcludeRgn := CreateRectRgn(0, 0, 0, 0); - if Integer( GetUpdateRgn(Sender.fHandle, Sender.fDblExcludeRgn, TRUE) ) <= NULLREGION then - begin - DeleteObject(Sender.fDblExcludeRgn); - exit; - end; + if Sender.fAnchors and PARENT_REQ_PAINT = 0 then + begin + Sender.fDblExcludeRgn := CreateRectRgn(0, 0, 0, 0); + if Integer( GetUpdateRgn(Sender.fHandle, Sender.fDblExcludeRgn, TRUE) ) <= NULLREGION then + begin + DeleteObject(Sender.fDblExcludeRgn); + exit; + end; - DC := BeginPaint(Sender.fHandle, PS); - PDC := CreateCompatibleDC( DC ); - GetClientRect(Msg.hwnd, Margins); - OLDp := SelectObject(PDC, CreateCompatibleBitmap(DC, Margins.Right, Margins.Bottom) ); - Sender.fParentCoordX := 0; - Sender.fParentCoordy := 0; - end else begin - PDC := Msg.wParam; - Sender.fDblExcludeRgn := Sender.fParent.fDblExcludeRgn; + DC := BeginPaint(Sender.fHandle, PS); + PDC := CreateCompatibleDC( DC ); + GetClientRect(Msg.hwnd, Margins); + OLDp := SelectObject(PDC, CreateCompatibleBitmap(DC, Margins.Right, Margins.Bottom) ); + Sender.fParentCoordX := 0; + Sender.fParentCoordy := 0; + end else + begin + PDC := Msg.wParam; + Sender.fDblExcludeRgn := Sender.fParent.fDblExcludeRgn; end; - Sender.fSelfRequirePaint := TRUE; + Sender.fAnchors := Sender.fAnchors or SELF_REQ_PAINT; Sender.fPaintDC := PDC; - if (not Sender.fParentRequirePaint) or Sender.fDoubleBuffered then - Sender.Perform(WM_ERASEBKGND, PDC, 0); + if (Sender.fAnchors and PARENT_REQ_PAINT = 0) or + {$IFDEF USE_FLAGS} (G2_DoubleBuffered in Sender.fFlagsG2) + {$ELSE} Sender.fDoubleBuffered {$ENDIF} then + Sender.Perform(WM_ERASEBKGND, PDC, 0); Sender.Perform(WM_PAINT, PDC, 0); @@ -40226,12 +40306,13 @@ begin C := Pointer( GetWindowLong( Wnd, GWL_USERDATA ) ); {$ENDIF} if CombineRgn(ChildRgn, ChildRgn, Sender.fDblExcludeRgn, RGN_AND) >= SIMPLEREGION then begin - with C{-}^{+} do begin - //if (C <> nil) and fTransparent then begin - if (C <> nil) and (fTransparent or fDoubleBuffered) then + with C^ do begin + if (C <> nil) and + {$IFDEF USE_FLAGS} ( [G2_DoubleBuffered, G2_Transparent] * fFlagsG2 <> [] ) + {$ELSE} (fTransparent or fDoubleBuffered) {$ENDIF} then begin Save := SaveDC( PDC ); - fParentRequirePaint := TRUE; + fAnchors := fAnchors or PARENT_REQ_PAINT; L := Sender.fParentCoordX + Left; T := Sender.fParentCoordY + Top; @@ -40246,8 +40327,7 @@ begin GetClientRect(Wnd, TR); IntersectClipRect(PDC, 0, 0, TR.Right, TR.Bottom); SendMessage(Wnd, WM_PAINT, PDC, 0); - - fParentRequirePaint := FALSE; + fAnchors := fAnchors and not PARENT_REQ_PAINT; RestoreDC( PDC, Save ); end else begin CombineRgn(Sender.fDblExcludeRgn, Sender.fDblExcludeRgn, ChildRgn, RGN_DIFF); @@ -40259,26 +40339,25 @@ begin Wnd := GetWindow( Wnd, GW_HWNDPREV ); end; Sender.fPaintDC := 0; - Sender.fSelfRequirePaint := FALSE; + Sender.fAnchors := Sender.fAnchors and not SELF_REQ_PAINT; - if not Sender.fParentRequirePaint then begin - BLTDC := GetDCEx(Sender.fHandle, 0, DCX_CACHE or DCX_CLIPSIBLINGS); - ExtSelectClipRgn(BLTDC, Sender.fDblExcludeRgn, RGN_AND); + if Sender.fAnchors and PARENT_REQ_PAINT = 0 then + begin + BLTDC := GetDCEx(Sender.fHandle, 0, DCX_CACHE or DCX_CLIPSIBLINGS); + ExtSelectClipRgn(BLTDC, Sender.fDblExcludeRgn, RGN_AND); - BitBlt(BLTDC, 0, 0, Margins.Right, Margins.Bottom, PDC, 0, 0, SRCCOPY ); + BitBlt(BLTDC, 0, 0, Margins.Right, Margins.Bottom, PDC, 0, 0, SRCCOPY ); - ReleaseDC(Sender.fHandle, BLTDC); - DeleteObject(SelectObject( PDC, OLDp )); - DeleteObject(Sender.fDblExcludeRgn); - DeleteDC( PDC ); - EndPaint(Sender.fHandle, PS); + ReleaseDC(Sender.fHandle, BLTDC); + DeleteObject(SelectObject( PDC, OLDp )); + DeleteObject(Sender.fDblExcludeRgn); + DeleteDC( PDC ); + EndPaint(Sender.fHandle, PS); end; end; end; {$ENDIF} -//[END WndProcTransparent] -//[FUNCTION WndProcPaint] {$IFDEF ASM_noVERSION} function WndProcPaint( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; const szPaintStruct = sizeof(TPaintStruct); @@ -40424,13 +40503,15 @@ var PaintStruct: TPaintStruct; Cplxity: Integer; OldPaintDC: HDC; begin - with Self_{-}^{+} do + with Self_^ do case Msg.message of //WM_PRINT, - WM_PAINT: if assigned( fOnPaint ) {or Assigned( fPaintProc )} then + WM_PAINT: if assigned( EV.fOnPaint ) then begin fUpdRgn := CreateRectRgn( 0, 0, 0, 0 ); - Cplxity := Integer( GetUpdateRgn( fHandle, fUpdRgn, fEraseUpdRgn ) ); + Cplxity := Integer( GetUpdateRgn( fHandle, fUpdRgn, + {$IFDEF USE_FLAGS} G5_EraseBkgnd in fFlagsG5 + {$ELSE} fEraseUpdRgn {$ENDIF} ) ); if (Cplxity = NULLREGION) or (Cplxity = ERROR) then begin DeleteObject( fUpdRgn ); @@ -40442,10 +40523,7 @@ begin if fPaintDC = 0 then fPaintDC := BeginPaint( fHandle, PaintStruct ); - //if fUpdRgn <> 0 then added in v2.16 - // SelectClipRgn( fPaintDC, fUpdRgn ); removed in v2.26 - - fOnPaint( Self_, fPaintDC ); + EV.fOnPaint( Self_, fPaintDC ); if assigned( Self_.fCanvas ) then Self_.fCanvas.SetHandle( 0 ); @@ -40466,51 +40544,49 @@ begin Result := FALSE; end; {$ENDIF ASM_VERSION} -//[END WndProcPaint] {$ENDIF WIN_GDI} -//[procedure TControl.SetOnPaint] {$IFDEF GDI} procedure TControl.SetOnPaint( const Value: TOnPaint ); begin - fOnPaint := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnPaint := Value; AttachProc( WndProcPaint ); end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function expose_widget( Widget: PGtkWidget; Event: PGdkEventExpose; +FUNCTION expose_widget( Widget: PGtkWidget; Event: PGdkEventExpose; Sender: PControl ): Boolean; cdecl; -begin - if not Assigned( Sender.fOnPaint ) then Result := FALSE - else - begin +BEGIN + IF not Assigned( Sender.fOnPaint ) THEN Result := FALSE + ELSE + BEGIN Sender.Canvas.SaveState; Sender.fOnPaint( Sender, Sender.Canvas.Handle ); Sender.Canvas.RestoreState; Result := TRUE; - end; -end; + END; +END; -procedure TControl.SetOnPaint( const Value: TOnPaint ); -begin - fOnPaint := Value; +PROCEDURE TControl.SetOnPaint( const Value: TOnPaint ); +BEGIN + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnPaint := Value; {$IFNDEF SMALLER_CODE} // it is actually not necessary to disconnect, event // still will be fired but fOnPaint is not assigned // so FALSE will be returned to GTK. - if not Assigned( Value ) then - gtk_signal_disconnect( fHandle, fExposeEvent ) - else + IF NOT Assigned( Value ) THEN + gtk_signal_disconnect( fHandle, fExposeEvent ) + ELSE {$ENDIF} - fExposeEvent := gtk_signal_connect( GTK_OBJECT( fHandle ), 'expose_event', - @ expose_widget, @ Self ); -end; + fExposeEvent := gtk_signal_connect( GTK_OBJECT( fHandle ), 'expose_event', + @ expose_widget, @ Self ); +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -//* -//[function WndProcEraseBkgnd] function WndProcEraseBkgnd( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var PaintStruct: TPaintStruct; OldPaintDC: HDC; @@ -40538,10 +40614,10 @@ begin end; end; -//[procedure TControl.SetOnEraseBkgnd] procedure TControl.SetOnEraseBkgnd(const Value: TOnPaint); begin - fOnEraseBkgnd := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnEraseBkgnd := Value; AttachProc( WndProcEraseBkgnd ); end; @@ -40571,7 +40647,7 @@ begin begin result := false; CR := Self_.ClientRect; - case Self_.fGradientStyle of + case Self_.DF.fGradientStyle of gsHorizontal: begin W := CR.Right; H := 1; @@ -40601,11 +40677,11 @@ begin if Self_.fPaintDC = 0 then Self_.fPaintDC := BeginPaint( Self_.fHandle, PaintStruct ); Bmp := NewDIBBitmap( W, H, pf24bit ); - C := Color2RGB( Self_.fColor1 ); + C := Color2RGB( Self_.DF.fColor1 ); R := C shr 16; G := (C shr 8) and $FF; B := C and $FF; - C := Color2RGB( Self_.fColor2 ); + C := Color2RGB( Self_.DF.fColor2 ); R1 := C shr 16; G1 := (C shr 8) and $FF; B1 := C and $FF; @@ -40613,12 +40689,12 @@ begin C := (( R + (R1 - R) * I div WH ) shl 16) or (( G + (G1 - G) * I div WH ) shl 8) or ( B + (B1 - B) * I div WH ); - if Self_.fGradientStyle = gsVertical then + if Self_.DF.fGradientStyle = gsVertical then Bmp.DIBPixels[ 0, I ] := C else Bmp.DIBPixels[ I, 0 ] := C; end; - if Self_.fGradientStyle = gsVertical then + if Self_.DF.fGradientStyle = gsVertical then Pattern := NewBitMap(pw, H) else Pattern := NewBitMap(W, pw); @@ -40628,7 +40704,7 @@ begin StretchBlt( pdc, 0, 0, Pattern.Width, Pattern.Height, Bmp.Canvas.Handle, 0, 0, W, H, SRCCOPY ); - case Self_.fGradientStyle of + case Self_.DF.fGradientStyle of gsHorizontal: for i := 0 to (CR.Bottom div pw) do Pattern.Draw(Self_.fPaintDC, 0, i*pw); gsVertical: for i := 0 to (CR.Right div pw) do @@ -40641,10 +40717,14 @@ begin Bmp.Free; Pattern.Free; - if TMethod( Self_.fOnPaint2 ).Code = @ DummyPaintClear then - Self_.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyPaintProc ) ); - if Assigned( Self_.fOnPaint ) then - Self_.fOnPaint( Self_, Self_.fPaintDC ); + if TMethod( Self_.EV.fOnPaint2 ).Code = @ DummyPaintClear then + {$IFDEF MAKE_METHOD} + Self_.EV.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyObjProc ) ); + {$ELSE} + TMethod( Self_.EV.fOnPaint2 ).Code := @DummyObjProc; + {$ENDIF} + if Assigned( Self_.EV.fOnPaint ) then + Self_.EV.fOnPaint( Self_, Self_.fPaintDC ); if Msg.wParam = 0 then EndPaint( Self_.fHandle, PaintStruct ); @@ -40680,7 +40760,7 @@ begin H := CR.Bottom; WH := H; Bmp := nil; - if Self_.fGradientStyle = gsHorizontal then + if Self_.DF.fGradientStyle = gsHorizontal then begin W := CR.Right; H := 1; @@ -40688,11 +40768,11 @@ begin end; if not W9x then Bmp := NewDIBBitmap( W, H, pf32bit ); - C := Color2RGB( Self_.fColor1 ); + C := Color2RGB( Self_.DF.fColor1 ); R := C shr 16; G := (C shr 8) and $FF; B := C and $FF; - C := Color2RGB( Self_.fColor2 ); + C := Color2RGB( Self_.DF.fColor2 ); R1 := C shr 16; G1 := (C shr 8) and $FF; B1 := C and $FF; @@ -40703,21 +40783,21 @@ begin ( B + (B1 - B) * I div WH ) and $FF; if W9x then begin - if Self_.fGradientStyle <> gsHorizontal then + if Self_.DF.fGradientStyle <> gsHorizontal then CR.Bottom := CR.Top + 1 else CR.Right := CR.Left + 1; Br := CreateSolidBrush( C ); Windows.FillRect( Self_.fPaintDC, CR, Br ); DeleteObject( Br ); - if Self_.fGradientStyle <> gsHorizontal then + if Self_.DF.fGradientStyle <> gsHorizontal then Inc( CR.Top ) else Inc( CR.Left ); end else begin - if Self_.fGradientStyle <> gsHorizontal then + if Self_.DF.fGradientStyle <> gsHorizontal then Bmp.DIBPixels[ 0, I ] := C else Bmp.DIBPixels[ I, 0 ] := C; @@ -40732,10 +40812,14 @@ begin Bmp.Free; end; - if TMethod( Self_.fOnPaint2 ).Code = @ DummyPaintClear then - Self_.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyPaintProc ) ); - if Assigned( Self_.fOnPaint ) then - Self_.fOnPaint( Self_, Self_.fPaintDC ); + if TMethod( Self_.EV.fOnPaint2 ).Code = @ DummyPaintClear then + {$IFDEF MAKE_METHOD} + Self_.EV.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyObjProc ) ); + {$ELSE} + TMethod( Self_.EV.fOnPaint2 ).Code := @DummyObjProc; + {$ENDIF} + if Assigned( Self_.EV.fOnPaint ) then + Self_.EV.fOnPaint( Self_, Self_.fPaintDC ); if Msg.wParam = 0 then EndPaint( Self_.fHandle, PaintStruct ); @@ -40748,9 +40832,7 @@ begin Result := False; end; {$ENDIF OLD_GRADIENT} -//[END WndProcGradient] -//[function WndProcGradientEx] function WndProcGradientEx( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; function Ceil( X: Double ): Integer; begin @@ -40783,16 +40865,16 @@ var begin Result := FALSE; if (Msg.message <> WM_PAINT) and (Msg.message <> WM_PRINTCLIENT) then Exit; - if Self_.fGradientStyle in [ gsHorizontal, gsVertical ] then + if Self_.DF.fGradientStyle in [ gsHorizontal, gsVertical ] then begin Result := WndProcGradient( Self_, Msg, Rslt ); Exit; end; - C := Color2RGB( Self_.fColor2 ); + C := Color2RGB( Self_.DF.fColor2 ); R2 := C and $FF; G2 := (C shr 8) and $FF; B2 := (C shr 16) and $FF; - C := Color2RGB( Self_.fColor1 ); + C := Color2RGB( Self_.DF.fColor1 ); R1 := C and $FF; G1 := (C shr 8) and $FF; B1 := (C shr 16) and $FF; @@ -40806,7 +40888,7 @@ begin RC := Self_.ClientRect; fX1 := 0; fY1 := 0; - case Self_.fGradientStyle of + case Self_.DF.fGradientStyle of gsRombic: begin fX2 := RC.Right / 128; @@ -40823,10 +40905,10 @@ begin fY2 := RC.Bottom / 256; end; end; - case Self_.fGradientStyle of + case Self_.DF.fGradientStyle of gsRectangle, gsRombic, gsElliptic: begin - case Self_.FGradientLayout of + case Self_.DF.fGradientLayout of glCenter, glTop, glBottom: OffsetF( (RC.Right - fX2) / 2, 0 ); glTopRight, glBottomRight, glRight: @@ -40834,7 +40916,7 @@ begin glTopLeft, glBottomLeft, glLeft: OffsetF( -fX2 / 2, 0 ); end; - case Self_.FGradientLayout of + case Self_.DF.fGradientLayout of glCenter, glLeft, glRight: OffsetF( 0, (RC.Bottom - fY2) / 2 ); glBottom, glBottomLeft, glBottomRight: @@ -40848,13 +40930,13 @@ begin DY1 := -fY1 / 255; // (-RF.Top) / 255; DX2 := (RC.Right - fX2) / 255; //(RC.Right - RF.Right) / 255; DY2 := (RC.Bottom - fY2) / 255; - case Self_.fGradientStyle of + case Self_.DF.fGradientStyle of gsRombic, gsElliptic: begin if DX2 < -DX1 then DX2 := -DX1; if DY2 < -DY1 then DY2 := -DY1; K := 2; - if Self_.fGradientStyle = gsElliptic then K := SQRT2; + if Self_.DF.fGradientStyle = gsElliptic then K := SQRT2; DX2 := DX2 * K; DY2 := DY2 * K; DX1 := -DX2; @@ -40869,7 +40951,7 @@ begin C2 := TColor( (( Ceil( B1 + DB * (I+1) ) and $FF) shl 16) or (( Ceil( G1 + DG * (I+1) ) and $FF) shl 8) or Ceil( R1 + DR * (I+1) ) and $FF ); - if (Self_.fGradientStyle in [gsRombic,gsElliptic,gsRectangle]) and + if (Self_.DF.fGradientStyle in [gsRombic,gsElliptic,gsRectangle]) and (C2 = C) then continue; end; Br := CreateSolidBrush( C ); @@ -40878,7 +40960,7 @@ begin Ceil( fX2 + DX2 * I ) + 1, Ceil( fY2 + DY2 * I ) + 1 ); Rgn := 0; - case Self_.fGradientStyle of + case Self_.DF.fGradientStyle of gsRectangle: Rgn := CreateRectRgnIndirect( R0 ); gsRombic: @@ -40908,19 +40990,23 @@ begin DeleteObject( Br ); C := C2; end; - if TMethod( Self_.fOnPaint2 ).Code = @ DummyPaintClear then - Self_.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyPaintProc ) ); - if Assigned( Self_.fOnPaint ) then - Self_.fOnPaint( Self_, Self_.fPaintDC ); - if Self_.fPaintDC <> HDC( Msg.wParam ) then - EndPaint( Self_.fHandle, PaintStruct ); + if TMethod( Self_.EV.fOnPaint2 ).Code = @ DummyPaintClear then + {$IFDEF MAKE_METHOD} + Self_.EV.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyObjProc ) ); + {$ELSE} + TMethod( Self_.EV.fOnPaint2 ).Code := @DummyObjProc; + {$ENDIF} + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnPaint ) then + {$ENDIF} + Self_.EV.fOnPaint( Self_, Self_.fPaintDC ); + if Self_.fPaintDC <> HDC( Msg.wParam ) then + EndPaint( Self_.fHandle, PaintStruct ); Self_.fPaintDC := OldPaintDC; Rslt := 0; Result := True; end; -//* -//[function WndProcLabelEffect] function WndProcLabelEffect( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Sz: TSize; @@ -40974,12 +41060,12 @@ begin Target := Self_.Canvas; Txt := Self_.fCaption; Target.{$IFDEF UNICODE_CTRLS}WTextArea{$ELSE}TextArea{$ENDIF}( Txt, Sz, P0 ); - if Self_.fShadowDeep <> 0 then + if Self_.DF.fShadowDeep <> 0 then begin - for B := False to Self_.fCtl3D do + for B := False to Self_.fCtl3D_child and 1 <> 0 do begin - Inc( Sz.cx, Abs( Self_.fShadowDeep ) ); - Inc( Sz.cy, Abs( Self_.fShadowDeep ) ); + Inc( Sz.cx, Abs( Self_.DF.fShadowDeep ) ); + Inc( Sz.cy, Abs( Self_.DF.fShadowDeep ) ); end; end; CR := Self_.ClientRect; @@ -40991,39 +41077,37 @@ begin vaCenter: P0.y := P0.y + (CR.Bottom - Sz.cy) div 2; vaBottom: P0.y := P0.y + (CR.Bottom - Sz.cy); end; - if Self_.fShadowDeep <> 0 then + if Self_.DF.fShadowDeep <> 0 then begin - if Self_.fColor2 = clNone then - CShadow := ColorsMix(Color2RGB(Self_.fTextColor),Color2RGB(Self_.fColor2)) + if Self_.DF.fColor2 = clNone then + CShadow := ColorsMix(Color2RGB(Self_.fTextColor),Color2RGB(Self_.DF.fColor2)) else - CShadow := Color2RGB( Self_.fColor2 ); - if not Self_.fTransparent then - Target.FillRect( CR ); // GDIFlush; for test only - //Target.DeselectHandles; + CShadow := Color2RGB( Self_.DF.fColor2 ); + if {$IFDEF USE_FLAGS} not(G2_Transparent in Self_.fFlagsG2) + {$ELSE} not Self_.fTransparent {$ENDIF} then + Target.FillRect( CR ); // GDIFlush; for test only Target.RequiredState( HandleValid or FontValid or BrushValid or ChangingCanvas ); SetBkMode( Target.fHandle, Windows.TRANSPARENT ); - if Self_.fCtl3D then + if Self_.fCtl3D_child and 1 <> 0 then begin - I := - Self_.fShadowDeep; - Istp := 1; - if Self_.ShadowDeep > 0 then Istp := -1; - repeat - J := - Self_.fShadowDeep; + I := - Self_.DF.fShadowDeep; + Istp := 1; + if Self_.DF.fShadowDeep > 0 then Istp := -1; repeat - if not ( (I=0) and (J=0) ) then - begin - if (I * Istp < 0) and (J * Istp < 0) then - begin - doTextOut( I, J, CShadow ); - end; - end; - J := J - Istp; - until J = Self_.fShadowDeep - IStp; - I := I - Istp; - until I = Self_.fShadowDeep - IStp; + J := - Self_.DF.fShadowDeep; + repeat + if not ( (I=0) and (J=0) ) then + begin + if (I * Istp < 0) and (J * Istp < 0) then + doTextOut( I, J, CShadow ); + end; + J := J - Istp; + until J = Self_.DF.fShadowDeep - IStp; + I := I - Istp; + until I = Self_.DF.fShadowDeep - IStp; end else - doTextout( Self_.fShadowDeep, Self_.fShadowdeep, CShadow ); + doTextout( Self_.DF.fShadowDeep, Self_.DF.fShadowdeep, CShadow ); doTextout( 0, 0, Color2RGB(Self_.fTextColor) ); end else @@ -41033,10 +41117,10 @@ begin doTextout( 0, 0, Color2RGB(Self_.fTextColor) ); end; end; - if assigned( Self_.fCanvas ) then - Self_.fCanvas.SetHandle( 0 ); - if MSg.wParam = 0 then - EndPaint( Self_.fHandle, PS ); + if Self_.fCanvas <> nil then + Self_.fCanvas.SetHandle( 0 ); + if Msg.wParam = 0 then + EndPaint( Self_.fHandle, PS ); Self_.fPaintDC := OldPaintDC; Rslt := 0; Result := True; @@ -41045,35 +41129,34 @@ begin end; end; -//[procedure TControl.DoClick] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.DoClick; begin - fControlClick( @Self ); - if Assigned( fOnClick ) then - fOnClick( @Self ); + PP.fControlClick( @Self ); + {$IFDEF NIL_EVENTS} + if Assigned( EV.fOnClick ) then + {$ENDIF} + EV.fOnClick( @Self ); end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[function TControl.ParentForm] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.ParentForm: PControl; begin Result := @Self; - if Result.fIsControl then + if {$IFDEF USE_FLAGS} G3_IsControl in Result.fFlagsG3 + {$ELSE} Result.fIsControl {$ENDIF} then repeat - Result := Result.fParent; - until (Result = nil) or not Result.fIsControl; + Result := Result.fParent; + until (Result = nil) or + {$IFDEF USE_FLAGS} not(G3_IsControl in Result.fFlagsG3) + {$ELSE} not Result.fIsControl {$ENDIF}; end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[procedure TControl.SetProgressColor] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetProgressColor(const Value: TColor); begin if Perform( PBM_SETBARCOLOR, 0, Color2RGB(Value) ) <> 0 then @@ -41081,17 +41164,14 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetShadowDeep] procedure TControl.SetShadowDeep(const Value: Integer); begin - fShadowDeep := Value; + DF.fShadowDeep := Value; Invalidate; end; {$ENDIF WIN_GDI} -//[function TControl.GetFont] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetFont: PGraphicTool; begin if FFont = nil then @@ -41108,9 +41188,7 @@ end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[function TControl.GetBrush] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetBrush: PGraphicTool; begin if FBrush = nil then @@ -41127,28 +41205,24 @@ end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[procedure TControl.FontChanged] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.FontChanged(Sender: PGraphicTool); begin fTextColor := Sender.fData.Color; - ApplyFont2Wnd; + ApplyFont2Wnd_Proc(@Self); Invalidate; end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[procedure TControl.BrushChanged] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.BrushChanged(Sender: PGraphicTool); begin fColor := Sender.fData.Color; - if fTmpBrush <> 0 then + if fTmpBrush <> 0 then begin - DeleteObject( fTmpBrush ); - fTmpBrush := 0; + DeleteObject( fTmpBrush ); + fTmpBrush := 0; end; if fPaintDC = 0 then // only if not in painting already : @@ -41158,9 +41232,7 @@ end; {$ENDIF WIN_GDI} {$IFDEF GDI} -//[procedure DoApplyFont2Wnd] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure DoApplyFont2Wnd( _Self: PControl ); begin if _Self.fFont <> nil then @@ -41177,51 +41249,41 @@ begin _Self.fCanvas := nil; end; - if Assigned( _Self.fAutoSize ) then - _Self.fAutoSize( _Self ); + _Self.DoAutoSize; end; end; {$ENDIF ASM_VERSION} {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure DoApplyFont2Wnd( _Self: PControl ); -var oldfontdesc: PPangoFontDescription; +PROCEDURE DoApplyFont2Wnd( _Self: PControl ); +VAR oldfontdesc: PPangoFontDescription; rcstyle: PGtkRcStyle; gcolor: TGdkColor; i: Integer; -begin - if Assigned( _Self.fFont ) then - begin - gcolor := Color2GdkColor( _Self.fFont.Color ); +BEGIN + IF ( _Self.fFont <> nil ) THEN + BEGIN + gcolor := Color2GdkColor( _Self.fFont.Color ); - rcstyle := gtk_widget_get_modifier_style( _Self.fHandle ); - oldfontdesc := rcstyle.font_desc; - rcstyle.font_desc := - pango_font_description_copy( _Self.fFont.GetPangoFontDesc ); - gtk_widget_modify_style( _Self.fHandle, rcstyle ); + rcstyle := gtk_widget_get_modifier_style( _Self.fHandle ); + oldfontdesc := rcstyle.font_desc; + rcstyle.font_desc := + pango_font_description_copy( _Self.fFont.GetPangoFontDesc ); + gtk_widget_modify_style( _Self.fHandle, rcstyle ); - if oldfontdesc <> nil then - pango_font_description_free( oldfontdesc ); + IF oldfontdesc <> nil THEN + pango_font_description_free( oldfontdesc ); - for i := 0 to 4 do - gtk_widget_modify_fg( _Self.fCaptionHandle, {GTK_STATE_NORMAL} i, @ gcolor ); - end; -end; + FOR i := 0 TO 4 DO + gtk_widget_modify_fg( _Self.fCaptionHandle, {GTK_STATE_NORMAL} i, @ gcolor ); + END; +END; {$ENDIF GTK} {$ENDIF _X_} -//[procedure TControl.ApplyFont2Wnd] -procedure TControl.ApplyFont2Wnd; -begin - if Assigned( ApplyFont2Wnd_Proc ) then - ApplyFont2Wnd_Proc( @ Self ); -end; - {$IFDEF WIN_GDI} -//[function TControl.ResizeParent] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.ResizeParent: PControl; begin ResizeParentBottom; @@ -41233,9 +41295,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.ResizeParentBottom] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.ResizeParentBottom: PControl; var NewCH: Integer; begin @@ -41243,17 +41303,17 @@ begin if fParent <> nil then begin NewCH := BoundsRect.Bottom + fParent.fMargin; - if (fParent.fChangedPosSz and $20) <> 0 then - if NewCH <> fParent.ClientHeight then Exit; + if {$IFDEF USE_FLAGS} G2_ChangedSize in fParent.fFlagsG2 + {$ELSE} (fParent.fChangedPosSz and $20) <> 0 {$ENDIF} then + if NewCH <> fParent.ClientHeight then Exit; fParent.ClientHeight := NewCH; - fParent.fChangedPosSz := fParent.fChangedPosSz or $20; + {$IFDEF USE_FLAGS} include( fParent.fFlagsG2, G2_ChangedSize ); + {$ELSE} fParent.fChangedPosSz := fParent.fChangedPosSz or $20; {$ENDIF} end; end; {$ENDIF ASM_VERSION} -//[function TControl.ResizeParentRight] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.ResizeParentRight: PControl; var NewCW: Integer; begin @@ -41261,17 +41321,17 @@ begin if fParent <> nil then begin NewCW := fBoundsRect.Right + fParent.fMargin; - if (fParent.fChangedPosSz and $10) <> 0 then - if NewCW < fParent.ClientWidth then Exit; + if {$IFDEF USE_FLAGS} G2_ChangedSize in fParent.fFlagsG2 + {$ELSE} (fParent.fChangedPosSz and $10) <> 0 {$ENDIF} then + if NewCW < fParent.ClientWidth then Exit; fParent.ClientWidth := NewCW; - fParent.fChangedPosSz := fParent.fChangedPosSz or $10; + {$IFDEF USE_FLAGS} include( fParent.fFlagsG2, G2_ChangedSize ); + {$ELSE} fParent.fChangedPosSz := fParent.fChangedPosSz or $10; {$ENDIF} end; end; {$ENDIF ASM_VERSION} -//[function TControl.GetClientHeight] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetClientHeight: Integer; begin with ClientRect do @@ -41279,9 +41339,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.GetClientWidth] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetClientWidth: Integer; begin with ClientRect do @@ -41289,9 +41347,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetClientHeight] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetClientHeight(const Value: Integer); var Delta: Integer; begin @@ -41301,9 +41357,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetClientWidth] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetClientWidth(const Value: Integer); var Delta: Integer; begin @@ -41313,36 +41367,33 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.CenterOnParent] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.CenterOnParent: PControl; var PCR: TRect; begin Result := @Self; - if (fParent = nil) or not fIsControl then - PCR := MakeRect( 0, 0, GetSystemMetrics( SM_CXSCREEN ), GetSystemMetrics( SM_CYSCREEN ) ) + if (fParent = nil) or + {$IFDEF USE_FLAGS} not(G3_IsControl in fFlagsG3) + {$ELSE} not fIsControl {$ENDIF} then + PCR := MakeRect( 0, 0, GetSystemMetrics( SM_CXSCREEN ), GetSystemMetrics( SM_CYSCREEN ) ) else - PCR := fParent.ClientRect; + PCR := fParent.ClientRect; GetWindowHandle; Left := (PCR.Right - PCR.Left - Width) div 2; Top := (PCR.Bottom - PCR.Top - Height) div 2; end; {$ENDIF ASM_VERSION} -//[function TControl.GetHasBorder] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetHasBorder: Boolean; begin UpdateWndStyles; - Result := LongBool( fStyle and (WS_BORDER or WS_THICKFRAME or WS_DLGFRAME)) + Result := LongBool( fStyle.Value and (WS_BORDER or WS_THICKFRAME or WS_DLGFRAME)) or LongBool( fExStyle and WS_EX_CLIENTEDGE ); end; {$ENDIF ASM_VERSION} {$IFDEF ASM_noVERSION} // YS -//[procedure TControl.SetHasBorder] procedure TControl.SetHasBorder(const Value: Boolean); const style_mask = WS_BORDER or WS_THICKFRAME or WS_DLGFRAME or WS_CAPTION or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU; @@ -41404,76 +41455,80 @@ begin if Value = GetHasBorder then Exit; if Value then begin - if not fIsControl then - Style := fStyle or WS_THICKFRAME or WS_BORDER or + if {$IFDEF USE_FLAGS} not(G3_IsControl in fFlagsG3) + {$ELSE} not fIsControl {$ENDIF} then + Style := fStyle.Value or WS_THICKFRAME or WS_BORDER or WS_DLGFRAME or WS_CAPTION or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU else - if fCtl3D then + if fCtl3D_child and 1 <> 0 then ExStyle := fExStyle or WS_EX_CLIENTEDGE - else - Style := fStyle or WS_BORDER; + else + Style := fStyle.Value or WS_BORDER; end else begin - NewStyle := fStyle and not (WS_BORDER or WS_THICKFRAME or WS_DLGFRAME or WS_CAPTION + NewStyle := fStyle.Value and not (WS_BORDER or WS_THICKFRAME or WS_DLGFRAME or WS_CAPTION or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU); - if not fIsControl then NewStyle := NewStyle or WS_POPUP; + if {$IFDEF USE_FLAGS} not(G3_IsControl in fFlagsG3) + {$ELSE} not fIsControl {$ENDIF} then + NewStyle := NewStyle or WS_POPUP; Style := NewStyle; ExStyle := fExStyle and not (WS_EX_CONTROLPARENT or WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE or WS_EX_CLIENTEDGE); end; + {$IFDEF USE_FLAGS} + {$ELSE} //+MTsv DN - if fIsControl then - if fTabStop then Style := fStyle or WS_TABSTOP - else Style := fStyle {xor} and not WS_TABSTOP; + if fIsControl then + if fTabStop then + Style := fStyle.Value or WS_TABSTOP + else + Style := fStyle.Value {xor} and not WS_TABSTOP; + {$ENDIF} end; {$ENDIF ASM_VERSION} -//[function TControl.GetHasCaption] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetHasCaption: Boolean; begin UpdateWndStyles; - Result := not LongBool( fStyle and (WS_POPUP or WS_DLGFRAME)) - or LongBool( fStyle and WS_CAPTION); + Result := not LongBool( fStyle.Value and (WS_POPUP or WS_DLGFRAME)) + or LongBool( fStyle.Value and WS_CAPTION); end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetHasCaption] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetHasCaption(const Value: Boolean); begin if Value = GetHasCaption then Exit; if Value then begin - Style := fStyle and not (WS_POPUP or WS_DLGFRAME) or WS_CAPTION; + Style := fStyle.Value and not (WS_POPUP or WS_DLGFRAME) or WS_CAPTION; end else begin - if fIsControl then - Style := fStyle and not WS_CAPTION or WS_DLGFRAME + if {$IFDEF USE_FLAGS} G3_IsControl in fFlagsG3 + {$ELSE} fIsControl {$ENDIF} then + Style := fStyle.Value and not WS_CAPTION or WS_DLGFRAME else - Style := fStyle and not (WS_CAPTION or WS_SYSMENU) or WS_POPUP; + Style := fStyle.Value and not (WS_CAPTION or WS_SYSMENU) or WS_POPUP; ExStyle := fExStyle or WS_EX_DLGMODALFRAME; end; end; {$ENDIF ASM_VERSION} -//[function TControl.GetCanResize] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetCanResize: Boolean; begin - //UpdateWndStyles; - //Result := LongBool( fStyle and WS_THICKFRAME); - Result := not fPreventResize; + {$IFDEF USE_FLAGS} + Result := not(G1_PreventResize in fFlagsG1); + {$ELSE} + Result := not fPreventResize; + {$ENDIF} end; {$ENDIF ASM_VERSION} -//[function WndProcCanResize] function WndProcCanResize( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean; var W, H: Integer; P: PMinMaxInfo; @@ -41482,8 +41537,13 @@ begin if M.message = WM_GETMINMAXINFO then begin Rslt := Sender.CallDefWndProc( M ); + {$IFDEF FIX_WIDTH_HEIGHT} W := Sender.FFixWidth; H := Sender.FFixHeight; + {$ELSE} + W := Sender.fBoundsRect.Right - Sender.fBoundsRect.Left; + H := Sender.fBoundsRect.Bottom - Sender.fBoundsRect.Top; + {$ENDIF} P := Pointer( M.lParam ); P.ptMinTrackSize.x := W; P.ptMinTrackSize.y := H; @@ -41498,7 +41558,7 @@ begin if (Rslt >= 10) and (Rslt <= 17) then begin {$IFDEF CANRESIZE_THICKFRAME} - Rslt := {-}HTBORDER{+}{++}(*18{HTBORDER}*){--}; + Rslt := HTBORDER; {$ELSE} Rslt := HTNOWHERE; {$ENDIF} @@ -41516,29 +41576,32 @@ begin Result := False; // continue message processing end; -//[procedure TControl.SetCanResize] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetCanResize( const Value: Boolean ); begin if Value = CanResize then Exit; + {$IFDEF USE_FLAGS} + if Value then exclude( fFlagsG1, G1_PreventResize ) + else include( fFlagsG1, G1_PreventResize ); + {$ELSE} fPreventResize := not Value; - {$IFDEF CANRESIZE_THICKFRAME} - if Value then - Style := Style or WS_THICKFRAME - else - Style := Style and not WS_THICKFRAME; {$ENDIF} + {$IFDEF CANRESIZE_THICKFRAME} + if Value then + Style := Style or WS_THICKFRAME + else + Style := Style and not WS_THICKFRAME; + {$ENDIF} + {$IFDEF FIX_WIDTH_HEIGHT} GetWindowHandle; FFixWidth := Width; FFixHeight := Height; + {$ENDIF FIX_WIDTH_HEIGHT} AttachProc( WndProcCanResize ); end; {$ENDIF ASM_VERSION} -//[function TControl.GetStayOnTop] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetStayOnTop: Boolean; begin UpdateWndStyles; @@ -41546,9 +41609,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetStayOnTop] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetStayOnTop(const Value: Boolean); begin if Value = GetStayOnTop then Exit; @@ -41565,89 +41626,76 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.UpdateWndStyles] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.UpdateWndStyles: PControl; begin Result := @Self; if fHandle = 0 then Exit; - fStyle := GetWindowLong( fHandle, GWL_STYLE ); + fStyle.Value := GetWindowLong( fHandle, GWL_STYLE ); fExStyle := GetWindowLong( fHandle, GWL_EXSTYLE ); fClsStyle := GetClassLong( fHandle, GCL_STYLE ); end; {$ENDIF ASM_VERSION} -//[function TControl.GetChecked] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetChecked: Boolean; begin - if bboFixed in fBitBtnOptions then - Result := fChecked + if bboFixed in DF.fBitBtnOptions then + Result := {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4 + {$ELSE} fChecked {$ENDIF} else Result := LongBool( Perform( BM_GETCHECK, 0, 0 ) ) ; //= BST_CHECKED; end; {$ENDIF ASM_VERSION} -//[procedure TControl.Set_Checked] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.Set_Checked(const Value: Boolean); begin - if bboFixed in fBitBtnOptions then + if bboFixed in DF.fBitBtnOptions then begin - fChecked := Value; - Invalidate; + {$IFDEF USE_FLAGS} include( fFlagsG4, G4_Checked ); + {$ELSE} fChecked := Value; {$ENDIF} + Invalidate; end else - Perform( BM_SETCHECK, Integer( Value ), 0 ); + Perform( BM_SETCHECK, Integer( Value ), 0 ); end; {$ENDIF ASM_VERSION} -//[function TControl.SetChecked] function TControl.SetChecked(const Value: Boolean): PControl; begin Perform( BM_SETCHECK, Integer( Value ), 0 ); Result := @Self; end; -//[function TControl.SetRadioCheckedOld] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal -function TControl.SetRadioCheckedOld: PControl; -begin - Result := @Self; - if fParent = nil then Exit; - CheckRadioButton( fParent.GetWindowHandle, - fParent.fRadio1st, - fParent.fRadioLast, - fMenu ); -end; -{$ENDIF ASM_VERSION} - -//* -//[function TControl.SetRadioChecked] -{$IFDEF ASM_VERSION} -{$ELSE PAS_VERSION} +{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} function TControl.SetRadioChecked: PControl; +{$IFDEF USE_FLAGS} +var WasStyle: DWORD; +{$ELSE} var WasTabStop: Boolean; +{$ENDIF} begin + {$IFDEF USE_FLAGS} + WasStyle := fStyle.Value; + exclude( fStyle.f2_Style, F2_Tabstop ); + DoClick; + fStyle.Value := WasStyle; + {$ELSE} WasTabStop := fTabStop; fTabStop := FALSE; DoClick; fTabStop := WasTabStop; + {$ENDIF} Result := @Self; end; {$ENDIF ASM_VERSION} -//[function TControl.GetCheck3] function TControl.GetCheck3: TTriStateCheck; begin Result := TTriStateCheck(Perform(BM_GETCHECK, 0, 0) and 3); end; -//[procedure TControl.SetCheck3] procedure TControl.SetCheck3(value: TTriStateCheck); var wp: WPARAM; @@ -41657,8 +41705,6 @@ begin Perform(BM_SETCHECK, wp, 0); end; -//* -//[procedure TControl.Click] procedure TControl.Click; begin if (fCommandActions.aClick <> 0) or @@ -41678,34 +41724,21 @@ type cpMax: LongInt; end; -//[function TControl.GetSelStart] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetSelStart: Integer; -//var SR: TCharRange; begin Result := 0; if fCommandActions.aGetSelRange <> 0 then - //Result := LoWord( Perform( fCommandActions.aGetSelRange, 0, 0 ) ) - Perform( fCommandActions.aGetSelRange, Integer( @ Result ), 0 ) - {else - if fCommandActions.aExGetSelRange <> 0 then - begin - Perform( fCommandActions.aExGetSelRange, 0, Integer( @SR ) ); - Result := SR.cpMin; - end}; + Perform( fCommandActions.aGetSelRange, Integer( @ Result ), 0 ); end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetSelStart] procedure TControl.SetSelStart(const Value: Integer); begin ItemSelected[ Value ] := True; end; -//[function TControl.GetSelLength] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetSelLength: Integer; var Start, Finish: Integer; begin @@ -41721,19 +41754,11 @@ begin begin Result := Perform( fCommandActions.aGetSelCount {and $7FFF}, 0, 0 ); end; - end - {else - if fCommandActions.aExGetSelRange <> 0 then - begin - Perform( fCommandActions.aExGetSelRange, 0, Integer( @SR ) ); - Result := SR.cpMax - SR.cpMin; - end}; + end; end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetSelLength] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetSelLength(const Value: Integer); var SR: TCharRange; begin @@ -41746,11 +41771,9 @@ begin else if fCommandActions.aExSetSelRange <> 0 then Perform( fCommandActions.aExSetSelRange, 0, Integer( @SR ) ); - // Preform( EM_SCROLLCARET, 0, 0 ); end; {$ENDIF ASM_VERSION} -//[function TControl.GetItems] {$IFDEF ASM_UNICODE} function TControl.GetItems(Idx: Integer): AnsiString; asm @@ -41774,7 +41797,12 @@ asm XCHG ESI, EAX // ESI = Idx' XOR EAX, EAX + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EBX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aGetItemLength + {$ELSE} MOVZX ECX, [EBX].fCommandActions.aGetItemLength + {$ENDIF} JECXZ @@ret_empty PUSH ECX // push aGetItemLength @@ -41792,7 +41820,12 @@ asm POP EDX // restore L LEA ECX, [EDX+1] MOV dword ptr [EAX], ECX + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EBX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aGetItemText + {$ELSE} MOVZX ECX, [EBX].fCommandActions.aGetItemText + {$ENDIF} JECXZ @@ret_buf PUSH EDX // save L @@ -41854,7 +41887,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetItems] {$IFDEF ASM_UNICODE} procedure TControl.SetItems(Idx: Integer; const Value: AnsiString); asm @@ -41865,7 +41897,12 @@ asm CALL ECX2PChar PUSH ECX // @Value[1] + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EBX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aSetItemText + {$ELSE} MOVZX ECX, [EBX].fCommandActions.aSetItemText + {$ENDIF} JECXZ @@1 PUSH 0 @@ -41903,7 +41940,12 @@ asm @@1: // @Value[1] in stack already POP EDX + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EBX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aDeleteItem + {$ELSE} MOVZX ECX, [EBX].fCommandActions.aDeleteItem + {$ENDIF} JECXZ @@exit {$IFNDEF NOT_FIX_CURINDEX} @@ -41992,9 +42034,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.GetItemsCount] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetItemsCount: Integer; begin Result := 0; @@ -42013,36 +42053,27 @@ begin end; {$ENDIF ASM_VERSION} -//* -//[procedure TControl.SetItemsCount] procedure TControl.SetItemsCount(const Value: Integer); begin if fCommandActions.aSetCount = 0 then Exit; Perform( fCommandActions.aSetCount, Value, 0 ); end; -//[function TControl.Item2Pos] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.Item2Pos(ItemIdx: Integer): DWORD; begin Result := ItemIdx; - if fCommandActions.aItem2Pos <> 0 then - begin - Result := Perform( fCommandActions.aItem2Pos, ItemIdx, 0 ); - //if Result < 0 then Result := 0; - end; + if Byte( fCommandActions.bItem2Pos ) <> 0 then + Result := Perform( fCommandActions.bItem2Pos, ItemIdx, 0 ); end; {$ENDIF ASM_VERSION} -//[function TControl.Pos2Item] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.Pos2Item(Pos: Integer): DWORD; begin Result := Pos; - if fCommandActions.aPos2Item <> 0 then - Result := Perform( fCommandActions.aPos2Item, Pos, 0 ); + if Byte( fCommandActions.bPos2Item ) <> 0 then + Result := Perform( fCommandActions.bPos2Item, Pos, 0 ); end; {$ENDIF ASM_VERSION} @@ -42055,7 +42086,9 @@ begin Result.SelStart := SelStart; Result.SelLength := SelLength; {$IFNDEF NOT_USE_RICHEDIT} - if fCannotDoubleBuf { TRUE for rich edit, FALSE for edit } then + if {$IFDEF USE_FLAGS} (G1_CanNotDoublebuf in fFlagsG1) + {$ELSE} fCannotDoubleBuf {$ENDIF} + { TRUE for rich edit, FALSE for edit } then begin P.X := 0; P.Y := 0; @@ -42087,11 +42120,12 @@ begin Perform( EM_SCROLLCARET, 0, 0 ); Cur := SavePosition; {$IFNDEF NOT_USE_RICHEDIT} - if fCannotDoubleBuf then - begin // RichEdit - if P.TopLine <> Cur.TopLine then - Perform( EM_LINESCROLL, 0, P.TopLine - Cur.TopLine ); - Perform( EM_SETSCROLLPOS, 0, Integer( @ P.ScrollPos ) ); + if {$IFDEF USE_FLAGS} (G1_CanNotDoublebuf in fFlagsG1) + {$ELSE} fCannotDoubleBuf {$ENDIF} then + begin // RichEdit + if P.TopLine <> Cur.TopLine then + Perform( EM_LINESCROLL, 0, P.TopLine - Cur.TopLine ); + Perform( EM_SETSCROLLPOS, 0, Integer( @ P.ScrollPos ) ); end else // Edit {$ENDIF USE_RICHEDIT} @@ -42146,7 +42180,6 @@ begin p.TopLine := p.TopLine + CountInsertDelLines; end; -//[function WndProcTabChar] function WndProcTabChar( Sender: PControl; var M: TMsg; var Rslt: Integer ): Boolean; begin if M.message = WM_CHAR then @@ -42157,21 +42190,24 @@ begin Result := FALSE; end; -//[function TControl.EditTabChar] function TControl.EditTabChar: PControl; begin AttachProc( WndProcTabChar ); Result := @Self; end; -//[function TControl.Add] {$IFDEF ASM_UNICODE} function TControl.Add(const S: KOLString): Integer; asm PUSH EBX MOV EBX, EAX // EBX = @Self + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EBX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aAddItem + {$ELSE} MOVZX ECX, [EBX].fCommandActions.aAddItem // ECX = aAddItem + {$ENDIF} JECXZ @@chk_addtext CALL EDX2PChar @@ -42196,7 +42232,12 @@ asm JMP @@exit @@chk_addtext: + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EBX].fCommandActions + MOV ECX, [ECX].TCommandActionsObj.aAddText + {$ELSE} MOV ECX, [EBX].fCommandActions.aAddText + {$ENDIF} JECXZ @@add_text_simple CALL ECX @@ -42225,18 +42266,16 @@ begin end else begin - if assigned( fCommandActions.aAddText ) then - fCommandActions.aAddText( @Self, S ) + if Assigned( fCommandActions.aAddText ) then + fCommandActions.aAddText( @Self, S ) else - Text := Text + S; + Text := Text + S; Result := 0; end; end; {$ENDIF ASM_VERSION} -//[procedure TControl.Delete] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.Delete(Idx: Integer); begin if fCommandActions.aDeleteItem <> 0 then @@ -42244,13 +42283,17 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.Insert] {$IFDEF ASM_UNICODE} function TControl.Insert(Idx: Integer; const S: AnsiString): Integer; asm CALL ECX2PChar PUSH ECX + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aInsertItem + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aInsertItem + {$ENDIF} JECXZ @@exit_1 PUSH EDX @@ -42272,9 +42315,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.GetItemSelected] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetItemSelected(ItemIdx: Integer): Boolean; var SS: Integer; begin @@ -42296,9 +42337,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetItemSelected] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetItemSelected(ItemIdx: Integer; const Value: Boolean); var SR: TCharRange; begin @@ -42325,31 +42364,25 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetCtl3D] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetCtl3D(const Value: Boolean); begin - fCtl3Dchild := Value; - //if fCtl3D = Value then Exit; - fCtl3D := Value; + //fCtl3D := Value; + fCtl3D_child := fCtl3D_child and not 1 or Integer( Value ) and 1; UpdateWndStyles; - if Value then + if Value then begin - Style := fStyle and not WS_BORDER; - ExStyle := fExStyle or WS_EX_CLIENTEDGE; - end - else + Style := fStyle.Value and not WS_BORDER; + ExStyle := fExStyle or WS_EX_CLIENTEDGE; + end else begin - Style := fStyle or WS_BORDER; - ExStyle := fExStyle and not WS_EX_CLIENTEDGE; + Style := fStyle.Value or WS_BORDER; + ExStyle := fExStyle and not WS_EX_CLIENTEDGE; end; end; {$ENDIF ASM_VERSION} -//[function TControl.Shift] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.Shift(dX, dY: Integer): PControl; begin Left := fBoundsRect.Left + dX; @@ -42358,43 +42391,41 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure SetKeyEvent] procedure SetKeyEvent( Self_: PControl ); begin - Self_.fWndProcKeybd := WndProcKeybd; + Self_.PP.fWndProcKeybd := WndProcKeybd; end; -//[procedure TControl.SetOnChar] procedure TControl.SetOnChar(const Value: TOnChar); begin - fOnChar := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnChar := Value; SetKeyEvent( @Self ); end; {$IFDEF SUPPORT_ONDEADCHAR} -//[procedure TControl.SetOnChar] procedure TControl.SetOnDeadChar(const Value: TOnChar); begin - fOnDeadChar := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnDeadChar := Value; SetKeyEvent( @Self ); end; {$ENDIF SUPPORT_ONDEADCHAR} -//[procedure TControl.SetOnKeyDown] procedure TControl.SetOnKeyDown(const Value: TOnKey); begin - fOnKeyDown := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnKeyDown := Value; SetKeyEvent( @Self ); end; -//[procedure TControl.SetOnKeyUp] procedure TControl.SetOnKeyUp(const Value: TOnKey); begin - fOnKeyUp := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnKeyUp := Value; SetKeyEvent( @Self ); end; -//[FUNCTION CollectTabControls] {$IFDEF ASM_TLIST} function CollectTabControls( Form: PControl ): PList; asm @@ -42427,9 +42458,17 @@ asm TEST byte ptr [EAX].TControl.fStyle+2, WS_TABSTOP shr 16 JZ @@call_recur + {$IFDEF USE_FLAGS} + MOV EDX, dword ptr [EAX].TControl.fStyle.f2_Style + OR DL, DH + AND DL, (1 shl F3_Disabled) or (1 shl F2_Tabstop) + CMP DL, (1 shl F2_Tabstop) + JNZ @@call_recur + {$ELSE} MOV DL, [EAX].TControl.fTabStop AND DL, [EAX].TControl.fEnabled JZ @@call_recur + {$ENDIF} CALL TControl.GetToBeVisible TEST AL, AL @@ -42444,8 +42483,8 @@ asm XOR EBX, EBX JECXZ @@e_loo2 @@loo2: LODSD - MOV EAX, [EAX].TControl.fTabOrder - CMP EAX, [EDX].TControl.fTabOrder + MOV AX, [EAX].TControl.fTabOrder + CMP AX, [EDX].TControl.fTabOrder JLE @@next2 POP ESI MOV ECX, EDX @@ -42462,10 +42501,16 @@ asm CALL TList.Add @@call_recur: - OR EBP, 1 // Result := TRUE; + //OR EBP, 1 // Result := TRUE; + INC EBP POP EAX + {$IFDEF USE_FLAGS} + TEST [EAX].TControl.fStyle.f3_Style, (1 shl F3_Disabled) + JNZ @@next + {$ELSE} MOVZX ECX, [EAX].TControl.fEnabled JECXZ @@next + {$ENDIF USE_FLAGS} PUSH EAX CALL @@collecttab POP EDX @@ -42494,8 +42539,12 @@ var R: PList; for I := 0 to P.fChildren.fCount - 1 do begin C := P.fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ]; - if C.fTabstop and C.fEnabled and C.ToBeVisible and - (C.fStyle and WS_TABSTOP <> 0) then + if {$IFDEF USE_FLAGS} (TRUE) + {$ELSE} C.fTabstop {$ENDIF} + and {$IFDEF USE_FLAGS} not(F3_Disabled in C.fStyle.f3_Style) + {$ELSE} C.fEnabled {$ENDIF} + and C.ToBeVisible and + (F2_Tabstop in C.fStyle.f2_Style) then begin D := nil; for J := 0 to R.fCount - 1 do @@ -42516,10 +42565,11 @@ var R: PList; Result := TRUE; end; end; - if C.fEnabled then + if {$IFDEF USE_FLAGS} not (F3_Disabled in C.fStyle.f3_Style) + {$ELSE} C.fEnabled {$ENDIF} then begin - if CollectTab( C ) then - R.Remove( C ); + if CollectTab( C ) then + R.Remove( C ); end; end; end; @@ -42545,9 +42595,7 @@ begin Result := R; end; {$ENDIF ASM_VERSION} -//[END CollectTabControls] -//[PROCEDURE Tabulate2Next] {$IFDEF ASM_TLIST} procedure Tabulate2Next( Form: PControl; Dir: Integer ); asm @@ -42558,10 +42606,10 @@ asm CALL CollectTabControls XCHG EDI, EAX // EDI = CL (list of controls) - MOV ECX, [EBX].TControl.fCurrentControl // C := Form.fCurrentControl + MOV ECX, [EBX].TControl.DF.fCurrentControl // C := Form.fCurrentControl XOR EBX, EBX // I = 0 JECXZ @@1 - MOV EBX, [ECX].TControl.fTabOrder // I = C.fTabOrder + MOV BX, [ECX].TControl.fTabOrder // I = C.fTabOrder @@1: MOV ECX, [EDI].TList.fCount MOV ESI, [EDI].TList.fItems @@ -42573,54 +42621,54 @@ asm @@loop: PUSH ECX LODSD - CMP [EAX].TControl.fTabOrder, EBX + CMP [EAX].TControl.fTabOrder, BX JZ @@next MOV ECX, [ESP+8] // ECX = Ctrl1 JECXZ @@c1nil - MOV ECX, [ECX].TControl.fTabOrder // ECX = Ctrl1.fTabOrder + MOV CX, [ECX].TControl.fTabOrder // ECX = Ctrl1.fTabOrder TEST EBP, EBP JGE @@c1ge - CMP [EAX].TControl.fTabOrder, EBX + CMP [EAX].TControl.fTabOrder, BX JGE @@2 - CMP [EAX].TControl.fTabOrder, ECX + CMP [EAX].TControl.fTabOrder, CX JLE @@2 @@c1new: MOV [ESP+8], EAX // Ctrl1 := C JMP @@2 -@@c1ge: CMP [EAX].TControl.fTabOrder, EBX +@@c1ge: CMP [EAX].TControl.fTabOrder, BX JLE @@2 - CMP [EAX].TControl.fTabOrder, ECX + CMP [EAX].TControl.fTabOrder, CX JL @@c1new JMP @@2 @@c1nil: TEST EBP, EBP JL @@c1nil_dirL - CMP [EAX].TControl.fTabOrder, EBX + CMP [EAX].TControl.fTabOrder, BX JG @@c1new JMP @@2 @@c1nil_dirL: - CMP [EAX].TControl.fTabOrder, EBX + CMP [EAX].TControl.fTabOrder, BX JL @@c1new @@2: MOV ECX, [ESP+4] // ECX = Ctrl2 JECXZ @@c2new - MOV ECX, [ECX].TControl.fTabOrder + MOV CX, [ECX].TControl.fTabOrder TEST EBP, EBP JL @@c2dirL - CMP [EAX].TControl.fTabOrder, ECX + CMP [EAX].TControl.fTabOrder, CX JGE @@next JMP @@c2new @@c2dirL: - CMP [EAX].TControl.fTabOrder, ECX + CMP [EAX].TControl.fTabOrder, CX JLE @@next @@c2new: MOV [ESP+4], EAX @@ -42642,9 +42690,14 @@ asm XCHG EAX, ECX {$IFDEF USE_GRAPHCTLS} + {$IFDEF USE_FLAGS} + TEST [EAX].TControl.fFlagsG6, 1 shl G6_GraphicCtl + JNZ @@4 + {$ELSE} CMP [EAX].TControl.fWindowed, 0 JZ @@4 {$ENDIF} + {$ENDIF} MOV ECX, [EAX].TControl.fHandle JECXZ @@no_handle @@4: @@ -42658,7 +42711,7 @@ asm DEC [EAX].TControl.fClickDisabled @@no_handle: - MOV [EBX].TControl.fCurrentControl, EAX + MOV [EBX].TControl.DF.fCurrentControl, EAX @@exit: XCHG EAX, EDI @@ -42674,48 +42727,47 @@ begin CL := CollectTabControls( Form ); I := 0; - C := Form.fCurrentControl; - if C <> nil then - I := C.fTabOrder; + C := Form.DF.fCurrentControl; + if C <> nil then + I := C.fTabOrder; Ctrl2 := nil; Ctrl1 := nil; for J := 0 to CL.fCount - 1 do begin - C := CL.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ J ]; - if C.fTabOrder = I then continue; - if (Ctrl1 = nil) - and ( (Dir >= 0) and (C.fTabOrder > I) - or (Dir < 0) and (C.fTabOrder < I) ) - or (Dir >= 0) - and (C.fTabOrder > I) and (C.fTabOrder < Ctrl1.fTabOrder) - or (Dir < 0) - and (C.fTabOrder < I) and (C.fTabOrder > Ctrl1.fTabOrder) - then Ctrl1 := C; - if (Ctrl2 = nil) - or (Dir >= 0) and (C.fTabOrder < Ctrl2.fTabOrder) - or (Dir < 0) and (C.fTabOrder > Ctrl2.fTabOrder) - then Ctrl2 := C; + C := CL.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ J ]; + if C.fTabOrder = I then continue; + if (Ctrl1 = nil) + and ( (Dir >= 0) and (C.fTabOrder > I) + or (Dir < 0) and (C.fTabOrder < I) ) + or (Dir >= 0) + and (C.fTabOrder > I) and (C.fTabOrder < Ctrl1.fTabOrder) + or (Dir < 0) + and (C.fTabOrder < I) and (C.fTabOrder > Ctrl1.fTabOrder) + then Ctrl1 := C; + if (Ctrl2 = nil) + or (Dir >= 0) and (C.fTabOrder < Ctrl2.fTabOrder) + or (Dir < 0) and (C.fTabOrder > Ctrl2.fTabOrder) + then Ctrl2 := C; end; - if Ctrl1 = nil then - Ctrl1 := Ctrl2; - if Ctrl1 <> nil then + if Ctrl1 = nil then + Ctrl1 := Ctrl2; + if Ctrl1 <> nil then begin - if (Ctrl1.fHandle <> 0) {$IFDEF USE_GRAPHCTLS} or not Ctrl1.fWindowed {$ENDIF} then - begin - Inc( Ctrl1.fClickDisabled ); - Ctrl1.Focused := TRUE; - Dec( Ctrl1.fClickDisabled ); - end; - Form.fCurrentControl := Ctrl1; + if (Ctrl1.fHandle <> 0) {$IFDEF USE_GRAPHCTLS} or + {$IFDEF USE_FLAGS} (G6_GraphicCtl in Ctrl1.fFlagsG6) + {$ELSE} not Ctrl1.fWindowed {$ENDIF} {$ENDIF} then + begin + Inc( Ctrl1.fClickDisabled ); + Ctrl1.Focused := TRUE; + Dec( Ctrl1.fClickDisabled ); + end; + Form.DF.fCurrentControl := Ctrl1; end; CL.Free; end; {$ENDIF ASM_VERSION} -//[END Tabulate2Next] -//[FUNCTION Tabulate2Control] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function Tabulate2Control( Self_: PControl; Key: DWORD; checkOnly: Boolean ): Boolean; var Form: PControl; begin @@ -42743,9 +42795,7 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END Tabulate2Control] -//[FUNCTION Tabulate2ControlEx] {$IFDEF ASM_TLIST} function Tabulate2ControlEx( Self_: PControl; Key: DWORD; checkOnly: Boolean ): Boolean; asm @@ -42861,7 +42911,7 @@ asm PUSHAD PUSH EDI CALL TControl.ParentForm - MOV ECX, [EAX].TControl.fCurrentControl + MOV ECX, [EAX].TControl.DF.fCurrentControl JECXZ @@fault1 MOV EBP, ECX // EBP = CurCtrl @@ -42885,8 +42935,14 @@ asm CMP EAX, EBP JE @@next {} + {$IFDEF USE_FLAGS} + MOV DX, word ptr [EAX].TControl.fStyle.f2_Style + AND DX, ($100 shl F3_Disabled) or (1 shl F2_Tabstop) + XOR DH, (1 shl F3_Disabled) + {$ELSE} MOV DL, [EAX].TControl.fEnabled AND DL, [EAX].TControl.fTabstop + {$ENDIF USE_FLAGS} JZ @@next {} ADD ESP, -16 @@ -42941,7 +42997,7 @@ asm TEST EDI, EDI JNZ @@no_go - MOV [EAX].TControl.fCurrentControl, ECX + MOV [EAX].TControl.DF.fCurrentControl, ECX INC [ECX].TControl.fClickDisabled PUSH ECX MOV ECX, [ECX].TControl.fHandle @@ -42987,7 +43043,7 @@ begin else begin CL := CollectTabControls( Form ); - I := CL.IndexOf( Form.fCurrentControl ); + I := CL.IndexOf( Form.DF.fCurrentControl ); Found := nil; if I >= 0 then begin @@ -42999,7 +43055,12 @@ begin begin Ctrl := CL.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ]; if Ctrl = CurCtrl then continue; - if not (Ctrl.fEnabled and Ctrl.fTabstop) then continue; + if not ({$IFDEF USE_FLAGS} not(F3_Disabled in Ctrl.fStyle.f3_Style) + {$ELSE} Ctrl.fEnabled {$ENDIF} + and + {$IFDEF USE_FLAGS} (F2_Tabstop in Ctrl.fStyle.f2_Style) + {$ELSE} Ctrl.fTabstop {$ENDIF} + ) then continue; GetWindowRect( Ctrl.Handle, R1 ); Dist := MaxInt; case Key of @@ -43063,38 +43124,33 @@ begin SetFocus( Found.fHandle ); Dec( Found.fClickDisabled ); end; - Form.fCurrentControl := Found; + Form.DF.fCurrentControl := Found; end; end; CL.Free; end; end; {$ENDIF ASM_VERSION} -//[END Tabulate2ControlEx] -//[function TControl.Tabulate] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.Tabulate: PControl; var F : PControl; begin Result := @Self; F := ParentForm; if F = nil then Exit; - F.fGotoControl := Tabulate2Control; + F.PP.fGotoControl := Tabulate2Control; end; {$ENDIF ASM_VERSION} -//[function TControl.TabulateEx] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.TabulateEx: PControl; var F : PControl; begin Result := @Self; F := ParentForm; if F = nil then Exit; - F.fGotoControl := Tabulate2ControlEx; + F.PP.fGotoControl := Tabulate2ControlEx; end; {$ENDIF ASM_VERSION} @@ -43114,20 +43170,18 @@ begin Result := @ Self; end; -//* -//[procedure TControl.GotoControl] procedure TControl.GotoControl(Key: DWORD); var Form: PControl; begin Form := ParentForm; if Form <> nil then - if assigned( Form.fGotoControl ) then - Form.fGotoControl( Form.fCurrentControl, Key, false ); + {$IFDEF NIL_EVENTS} + if Assigned( Form.PP.fGotoControl ) then + {$ENDIF} + Form.PP.fGotoControl( Form.DF.fCurrentControl, Key, false ); end; -//[function TControl.GetCurIndex] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetCurIndex: Integer; var I, J: Integer; begin @@ -43147,9 +43201,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetCurIndex] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetCurIndex(const Value: Integer); var NMHdr: TNMHdr; idx: Integer; begin @@ -43171,16 +43223,14 @@ end; {$ENDIF WIN_GDI} {$IFDEF GDI} -//[function TControl.GetTextAlign] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetTextAlign: TTextAlign; begin UpdateWndStyles; - if (fStyle and fCommandActions.aTextAlignRight) = fCommandActions.aTextAlignRight then + if (fStyle.Value and fCommandActions.aTextAlignRight) = fCommandActions.aTextAlignRight then Result := taRight else - if (fStyle and fCommandActions.aTextAlignCenter) = fCommandActions.aTextAlignCenter then + if (fStyle.Value and fCommandActions.aTextAlignCenter) = fCommandActions.aTextAlignCenter then Result := taCenter else Result := fTextAlign; @@ -43189,89 +43239,86 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function TControl.GetTextAlign: TTextAlign; -begin +FUNCTION TControl.GetTextAlign: TTextAlign; +BEGIN Result := fTextAlign; -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF GDI} -//[procedure TControl.SetTextAlign] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetTextAlign(const Value: TTextAlign); var NewStyle: DWORD; begin fTextAlign := Value; NewStyle := 0; - with fCommandActions do + with fCommandActions{$IFDEF COMMANDACTIONS_OBJ}^{$ENDIF} do case Value of - taLeft: NewStyle := fStyle and not DWORD(aTextAlignCenter or aTextAlignRight) + taLeft: NewStyle := fStyle.Value and not DWORD(aTextAlignCenter or aTextAlignRight) or aTextAlignLeft; - taRight: NewStyle := fStyle and not DWORD(aTextAlignLeft or aTextAlignCenter) + taRight: NewStyle := fStyle.Value and not DWORD(aTextAlignLeft or aTextAlignCenter) or aTextAlignRight; - taCenter: NewStyle := fStyle and not DWORD(aTextAlignLeft or aTextAlignRight) + taCenter: NewStyle := fStyle.Value and not DWORD(aTextAlignLeft or aTextAlignRight) or aTextAlignCenter; end; - NewStyle := NewStyle and not DWORD(fCommandActions.aTextAlignMask); + NewStyle := NewStyle and not DWORD(fCommandActions.bTextAlignMask); Style := NewStyle; end; {$ENDIF ASM_VERSION} {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TControl.SetTextAlign(const Value: TTextAlign); -begin - if fTextAlign = Value then Exit; +PROCEDURE TControl.SetTextAlign(const Value: TTextAlign); +BEGIN + IF fTextAlign = Value THEN Exit; fTextAlign := Value; - if Assigned( fSetTextAlign ) then - fSetTextAlign( @ Self ); -end; + IF Assigned( fSetTextAlign ) THEN + fSetTextAlign( @ Self ); +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF GDI} -//[function TControl.GetVerticalAlign] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetVerticalAlign: TVerticalAlign; begin UpdateWndStyles; - if (fStyle and (fCommandActions.aVertAlignCenter shl 8)) = (fCommandActions.aVertAlignCenter shl 8) then - Result := vaCenter + if (fStyle.Value and (Byte( fCommandActions.bVertAlignCenter ) shl 8)) + = (Byte( fCommandActions.bVertAlignCenter ) shl 8) then + Result := vaCenter else - if (fStyle and (fCommandActions.aVertAlignBottom shl 8)) = (fCommandActions.aVertAlignBottom shl 8) then - Result := vaBottom + if (fStyle.Value and (fCommandActions.bVertAlignBottom shl 8)) + = (fCommandActions.bVertAlignBottom shl 8) then + Result := vaBottom else - Result := fVerticalAlign; + Result := fVerticalAlign; end; {$ENDIF ASM_VERSION} {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function TControl.GetVerticalAlign: TVerticalAlign; -begin +FUNCTION TControl.GetVerticalAlign: TVerticalAlign; +BEGIN Result := fVerticalAlign; -end; +END; {$ENDIF GTK} {$ENDIF _X_} -//[procedure TControl.SetVerticalAlign] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetVerticalAlign(const Value: TVerticalAlign); var NewStyle: DWORD; begin fVerticalAlign := Value; - with fCommandActions do + with fCommandActions{$IFDEF COMMANDACTIONS_OBJ}^{$ENDIF} do begin - NewStyle := fStyle and not DWORD((aVertAlignTop or aVertAlignCenter or aVertAlignBottom) shl 8); + NewStyle := fStyle.Value and + not DWORD((bVertAlignTop or bVertAlignCenter or bVertAlignBottom) shl 8); case Value of - vaCenter: NewStyle := NewStyle or (aVertAlignCenter shl 8); - vaTop: NewStyle := NewStyle or (aVertAlignTop shl 8); - vaBottom: NewStyle := NewStyle or (aVertAlignBottom shl 8); + vaCenter: NewStyle := NewStyle or (bVertAlignCenter shl 8); + vaTop: NewStyle := NewStyle or (bVertAlignTop shl 8); + vaBottom: NewStyle := NewStyle or (bVertAlignBottom shl 8); end; end; Style := NewStyle; @@ -43280,20 +43327,18 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure TControl.SetVerticalAlign(const Value: TVerticalAlign); -begin +PROCEDURE TControl.SetVerticalAlign(const Value: TVerticalAlign); +BEGIN if fVerticalAlign = Value then Exit; fVerticalAlign := Value; if Assigned( fSetTextAlign ) then fSetTextAlign( @ Self ); -end; +END; {$ENDIF GTK} {$ENDIF _X_} {$IFDEF WIN_GDI} -//[function TControl.Dc2Canvas] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.Dc2Canvas( Sender: PCanvas ): HDC; begin if fPaintDC <> 0 then @@ -43314,21 +43359,19 @@ end; {$ENDIF WIN_GDI} -//[function TControl.GetCanvas] {$IFDEF GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetCanvas: PCanvas; begin - if not assigned( fCanvas ) then + if ( fCanvas = nil ) then begin fCanvas := NewCanvas( 0 ); - fCanvas.OnGetHandle := Dc2Canvas; + fCanvas.fOnGetHandle := Dc2Canvas; fCanvas.fOwnerControl := @Self; - if assigned( fFont ) then - fCanvas.fFont := fCanvas.fFont.Assign( fFont ); - if assigned( fBrush ) then - fCanvas.fBrush := fCanvas.fBrush.Assign( fBrush ); + if ( fFont <> nil ) then + fCanvas.fFont := fCanvas.fFont.Assign( fFont ); + if ( fBrush <> nil ) then + fCanvas.fBrush := fCanvas.fBrush.Assign( fBrush ); end; Result := fCanvas; end; @@ -43336,31 +43379,30 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -function TControl.ProvideCanvasHandle( Sender: PCanvas ): HDC; -type PPGdkGC = ^PGdkGC; -var Array_gc: PPGdkGC; -begin - if fInBkPaint then Array_gc := @ fEventboxHandle.style.bg_gc[ 0 ] - else - Array_gc := @ fEventboxHandle.style.fg_gc[ 0 ]; +FUNCTION TControl.ProvideCanvasHandle( Sender: PCanvas ): HDC; +TYPE PPGdkGC = ^PGdkGC; +VAR Array_gc: PPGdkGC; +BEGIN + IF fInBkPaint THEN Array_gc := @ fEventboxHandle.style.bg_gc[ 0 ] + ELSE Array_gc := @ fEventboxHandle.style.fg_gc[ 0 ]; CASE fEventboxHandle.state OF GTK_STATE_NORMAL, GTK_STATE_ACTIVE, GTK_STATE_PRELIGHT, GTK_STATE_SELECTED, GTK_STATE_INSENSITIVE: Result := PPGdkGC( Integer( Array_gc ) + fEventboxHandle.state * sizeof( Pointer ) )^; - else Result := Array_gc^; + ELSE Result := Array_gc^; END; -end; +END; function TControl.GetCanvas: PCanvas; begin - if not assigned( fCanvas ) then + if ( fCanvas = nil ) then begin - fCanvas := NewCanvas( nil ); - fCanvas.OnGetHandle := ProvideCanvasHandle; - fCanvas.fOwnerControl := @Self; - fCanvas.fDrawable := Pointer( fEventboxHandle.window ); + fCanvas := NewCanvas( nil ); + fCanvas.fOnGetHandle := ProvideCanvasHandle; + fCanvas.fOwnerControl := @Self; + fCanvas.fDrawable := Pointer( fEventboxHandle.window ); end; fCanvas.GetHandle; // получим здесь тот контекст, который соответствует // текущему состоянию контрола (если это контрол) и текущей @@ -43371,7 +43413,6 @@ end; {$ENDIF _X_} {$IFDEF WIN_GDI} -//[function TControl.DblBufTopParent] function TControl.DblBufTopParent: PControl; var Ctl: PControl; begin @@ -43379,34 +43420,49 @@ begin Ctl := @ Self; while Ctl <> nil do begin - if (Ctl.fDoubleBuffered) or (Ctl.fTransparent) then - Result := Ctl; + if {$IFDEF USE_FLAGS} ( [G2_DoubleBuffered, G2_Transparent] * Ctl.fFlagsG2 <> [] ) + {$ELSE} (Ctl.fDoubleBuffered) or (Ctl.fTransparent) {$ENDIF} then + Result := Ctl; Ctl := Ctl.fParent; end; end; -//[procedure TControl.SetDoubleBuffered] +{$IFDEF ASM_VERSION}{$ELSE PASCAL} procedure TControl.SetDoubleBuffered(const Value: Boolean); begin - if CannotDoubleBuf then Exit; - fDoubleBuffered := Value; + if {$IFDEF USE_FLAGS} (G1_CanNotDoublebuf in fFlagsG1) + {$ELSE} CannotDoubleBuf {$ENDIF} then Exit; + {$IFDEF USE_FLAGS} + if Value then + include( fFlagsG2, G2_DoubleBuffered ) + else exclude( fFlagsG2, G2_DoubleBuffered ); + {$ELSE} fDoubleBuffered := Value; {$ENDIF} AttachProc(WndProcTransparent); {$IFNDEF SMALLEST_CODE} Global_AttachProcExtension := @TransparentAttachProcExtension; {$ENDIF} end; +{$ENDIF ASM_VERSION} -//[procedure TControl.SetTransparent] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetTransparent(const Value: Boolean); begin - fTransparent := Value; if fParent = nil then Exit; + {$IFDEF USE_FLAGS} + if Value then + include( fFlagsG2, G2_Transparent ) + else exclude( fFlagsG2, G2_Transparent ); + {$ELSE} fTransparent := Value; {$ENDIF} {$IFDEF GRAPHCTL_XPSTYLES} - if not AppTheming then - fClassicTransparent := Value; + if not AppTheming then + begin + {$IFDEF USE_FLAGS} + if Value then + include( fFlagsG3, G3_ClassicTransparent ) + else exclude( fFlagsG3, G3_ClassicTransparent ); + {$ELSE} fClassicTransparent := Value; {$ENDIF} + end; {$ENDIF} if Value then begin @@ -43416,7 +43472,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.SetBorder] function TControl.SetBorder( Value: Integer ): PControl; begin fMargin := Value; @@ -43427,7 +43482,6 @@ end; var FTrayItems: PList; -//[FUNCTION WndProcTray] {$IFDEF ASM_noVERSION} // ASM_TLIST! function WndProcTray( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; asm @@ -43496,8 +43550,8 @@ begin CM_TRAYICON: begin Self_ := Pointer( Msg.wParam ); - if Assigned( Self_.FOnMouse ) then - Self_.FOnMouse( @Self_, Msg.lParam ); + if Assigned( Self_.FOnMouse ) then + Self_.FOnMouse( @Self_, Msg.lParam ); Rslt := 0; Result := True; end; @@ -43516,7 +43570,6 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END WndProcTray] function WndProcTrayIconWnd( Wnd: HWnd; Msg: DWORD; wParam, lParam: Integer ): Integer; stdcall; @@ -43528,30 +43581,29 @@ begin if Msg = CM_TRAYICON then begin Tr := Pointer( wParam ); - if Assigned( Tr.FOnMouse ) then - Tr.FOnMouse( Tr, lParam ); + if Assigned( Tr.FOnMouse ) then + Tr.FOnMouse( Tr, lParam ); Result := 0; Exit; end else if Msg = WM_CLOSE then begin - if Assigned( PrevProc ) then + if Assigned( PrevProc ) then begin - SetWindowLong( Wnd, GWL_WNDPROC, Integer( @ PrevProc ) ); - RemoveProp( Wnd, 'TRAYSAVEPROC' ); - PostMessage( Wnd, WM_CLOSE, wParam, lParam ); - Result := 0; - Exit; + SetWindowLong( Wnd, GWL_WNDPROC, Integer( @ PrevProc ) ); + RemoveProp( Wnd, 'TRAYSAVEPROC' ); + PostMessage( Wnd, WM_CLOSE, wParam, lParam ); + Result := 0; + Exit; end; end; - if (Wnd <> 0) and IsWindow( Wnd ) and Assigned( PrevProc ) then - Result := PrevProc( Wnd, Msg, wParam, lParam ) + if (Wnd <> 0) and IsWindow( Wnd ) and Assigned( PrevProc ) then + Result := PrevProc( Wnd, Msg, wParam, lParam ) else - Result := DefWindowProc( Wnd, Msg, wParam, lParam ); + Result := DefWindowProc( Wnd, Msg, wParam, lParam ); end; -//[PROCEDURE TTrayIcon.AttachProc2Wnd] procedure TTrayIcon.AttachProc2Wnd; begin if FWnd = 0 then Exit; @@ -43566,24 +43618,23 @@ procedure TTrayIcon.DetachProc2Wnd; var OldProc: function ( Wnd: HWnd; Msg: DWORD; wParam, lParam: Integer ): Integer; stdcall; begin - if FWnd = 0 then Exit; - OldProc := Pointer( GetProp( FWnd, 'TRAYSAVEPROC' ) ); - if not Assigned( OldProc ) then Exit; // not attached - SetWindowLong( FWnd, GWL_WNDPROC, Integer( @ OldProc ) ); - RemoveProp( FWnd, 'TRAYSAVEPROC' ); + if FWnd = 0 then Exit; + OldProc := Pointer( GetProp( FWnd, 'TRAYSAVEPROC' ) ); + if not Assigned( OldProc ) then Exit; // not attached + SetWindowLong( FWnd, GWL_WNDPROC, Integer( @ OldProc ) ); + RemoveProp( FWnd, 'TRAYSAVEPROC' ); end; // [END TTrayIcon.DetachProc2Wnd] -//[FUNCTION NewTrayIcon] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewTrayIcon( Wnd: PControl; Icon: HIcon ): PTrayIcon; begin if FTrayItems = nil then FTrayItems := NewList; - {-} New( Result, Create ); - {+}{++}(*Result := PTrayIcon.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TTrayIcon'; + {$ENDIF} FTrayItems.Add( Result ); if Wnd <> nil then Wnd.AttachProc( WndProcTray ); @@ -43592,13 +43643,10 @@ begin Result.Active := True; end; {$ENDIF ASM_VERSION} -//[END NewTrayIcon] var fRecreateMsg: DWORD; -//[FUNCTION WndProcRecreateTrayIcons] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProcRecreateTrayIcons( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var I: Integer; TI: PTrayIcon; @@ -43619,14 +43667,11 @@ begin Result := False; end; {$ENDIF ASM_VERSION} -//[END WndProcRecreateTrayIcons] const TaskbarCreatedMsg: array[ 0..14 ] of KOLChar = ('T','a','s','k','b','a','r', 'C','r','e','a','t','e','d',#0); -//[procedure TTrayIcon.SetAutoRecreate] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TTrayIcon.SetAutoRecreate(const Value: Boolean); begin fAutoRecreate := Value; @@ -43635,9 +43680,7 @@ begin end; {$ENDIF ASM_VERSION} -//[destructor TTrayIcon.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TTrayIcon.Destroy; begin Active := False; @@ -43653,9 +43696,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TTrayIcon.SetActive] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TTrayIcon.SetActive(const Value: Boolean); begin if FActive = Value then Exit; @@ -43669,9 +43710,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TTrayIcon.SetIcon] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TTrayIcon.SetIcon(const Value: HIcon); var Cmd : DWORD; begin @@ -43689,7 +43728,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TTrayIcon.SetTooltip] {$IFDEF ASM_UNICODE} procedure TTrayIcon.SetTooltip(const Value: AnsiString); asm @@ -43721,7 +43759,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TTrayIcon.SetTrayIcon] {$IFDEF ASM_UNICODE} procedure TTrayIcon.SetTrayIcon(const Value: DWORD); const sz_tid = sizeof( TNotifyIconData ); @@ -43804,9 +43841,7 @@ end; var JustOneMutex: THandle; -//[FUNCTION WndProcJustOne] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProcJustOne( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; begin Result := False; @@ -43820,11 +43855,9 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END WndProcJustOne] -//[FUNCTION JustOne] -{$IFDEF ASM_noVERSION} -function JustOne( Wnd: PControl; const Identifier : AnsiString ) : Boolean; +{$IFDEF ASM_noUNICODE} +function JustOne( Wnd: PControl; const Identifier : KOLString ) : Boolean; asm PUSH EBX PUSH ESI @@ -43877,15 +43910,15 @@ asm POP EBX end; {$ELSE ASM_VERSION} //Pascal -function JustOne( Wnd: PControl; const Identifier : AnsiString ) : Boolean; +function JustOne( Wnd: PControl; const Identifier : KOLString ) : Boolean; var CritSecMutex : THandle; DW : Longint; begin Result := False; - CritSecMutex := CreateMutexA( nil, True, nil ); + CritSecMutex := CreateMutex( nil, True, nil ); if CritSecMutex = 0 then Exit; - JustOneMutex := CreateMutexA( nil, False, PAnsiChar( Identifier ) ); + JustOneMutex := CreateMutex( nil, False, PKOLChar( Identifier ) ); if JustOneMutex <> 0 then begin DW := WaitForSingleObject( JustOneMutex, 0 ); @@ -43895,7 +43928,6 @@ begin CloseHandle( CritSecMutex ); end; {$ENDIF ASM_VERSION} -//[END JustOne] { JustOneNotify } @@ -43903,7 +43935,6 @@ var OnAnotherInstance: TOnAnotherInstance; JustOneMsg: DWORD; -//[FUNCTION WndProcJustOneNotify] {$IFDEF ASM_UNICODE} function WndProcJustOneNotify( Control: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; asm @@ -43958,30 +43989,27 @@ var Buf : array[0..MAX_PATH] of KOLChar; begin WndProcJustOne( Control, Msg, Rslt ); Result := False; - if Msg.message = JustOneMsg then + if Msg.message = JustOneMsg then begin - Result := True; - if assigned( OnAnotherInstance ) then - begin - GetWindowText( Msg.lParam, Buf, MAX_PATH ); - OnAnotherInstance( Buf ); - end; - Rslt := 0; + Result := True; + if assigned( OnAnotherInstance ) then + begin + GetWindowText( Msg.lParam, Buf, MAX_PATH ); + OnAnotherInstance( Buf ); + end; + Rslt := 0; end; end; {$ENDIF ASM_VERSION} -//[END WndProcJustOneNotify] // Redefine here incorrectly declared BroadcastSystemMessage API function. // It should not refer to BroadcastSystemMessageA, which is not present in // earlier versions of Windows95, but to BroadcastSystemMessage, which is // present in all Windows95/98/Me and NT/2K/XP. -//[API BroadcastSystemMessage] function BroadcastSystemMessage(Flags: DWORD; Recipients: PDWORD; uiMessage: UINT; wParam: WPARAM; lParam: LPARAM): Longint; stdcall; external user32 name 'BroadcastSystemMessage'; -//[FUNCTION JustOneNotify] {$IFDEF ASM_UNICODE} function JustOneNotify( Wnd: PControl; const Identifier : AnsiString; const aOnAnotherInstance: TOnAnotherInstance ) : Boolean; @@ -44079,7 +44107,7 @@ end; function JustOneNotify( Wnd: PControl; const Identifier : KOLString; const aOnAnotherInstance: TOnAnotherInstance ) : Boolean; var Recipients : DWord; - OldCap: AnsiString; + OldCap: KOLString; begin Result := False; JustOneMsg := RegisterWindowMessage( PKOLChar( 'Message.' + Identifier ) ); @@ -44108,28 +44136,21 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END JustOneNotify] ///////////////////////////////////////// STRING LIST OBJECT ///////////////// {$ENDIF WIN} { TStrList } -//[function NewStrList] function NewStrList: PStrList; begin - {-} New( Result, Create ); - {+} - {++}(* - Result := PStrList.Create; - *){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TStrList'; + {$ENDIF} end; -//[END NewStrList] -//[destructor TStrList.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TStrList.Destroy; begin Clear; @@ -44137,18 +44158,15 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.Init] procedure TStrList.Init; begin - {$IFDEF _D2orD3} + {$IFDEF CALL_INHERITED} inherited; {$ENDIF} fNameDelim := DefaultNameDelimiter; end; -//[function TStrList.Add] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TStrList.Add(const S: Ansistring): integer; begin Result := fCount; @@ -44156,18 +44174,14 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.AddStrings] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TStrList.AddStrings(Strings: PStrList); begin SetText( Strings.Text, True ); end; {$ENDIF ASM_VERSION} -//[procedure TStrList.Assign] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TStrList.Assign(Strings: PStrList); begin Clear; @@ -44175,9 +44189,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.Clear] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TStrList.Clear; var I: Integer; begin @@ -44199,7 +44211,6 @@ end; {$IFDEF ASM_VERSION} {$DEFINE TStrList_Delete_ASM} {$ENDIF} {$IFDEF TLIST_FAST} {$UNDEF TStrList_Delete_ASM} {$ENDIF} -//[procedure TStrList.Delete] {$IFDEF TStrList_Delete_ASM} {$ELSE ASM_VERSION} //Pascal procedure TStrList.Delete(Idx: integer); @@ -44219,15 +44230,12 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.DeleteLast] procedure TStrList.DeleteLast; begin Delete( Count-1 ); end; -//[function TStrList.Get] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TStrList.Get(Idx: integer): Ansistring; begin if fList <> nil then @@ -44236,7 +44244,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TStrList.GetPChars] {$IFDEF ASM_TLIST} function TStrList.GetPChars(Idx: Integer): PAnsiChar; asm @@ -44251,7 +44258,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TStrList.GetTextStr] {$IFDEF ASM_TLIST} function TStrList.GetTextStr: Ansistring; @@ -44354,7 +44360,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TStrList.IndexOf] {$IFDEF ASM_TLIST} function TStrList.IndexOf(const S: Ansistring): integer; asm @@ -44405,7 +44410,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TStrList.IndexOf] function TStrList.IndexOf_NoCase(const S: AnsiString): integer; var tmp: PAnsiChar; c: AnsiChar; @@ -44456,7 +44460,6 @@ begin Result := _AnsiCompareStrNoCaseA( S1, S2 ); end; -//[function TStrList.Find] function TStrList.Find(const S: AnsiString; var Index: Integer): Boolean; var L, H, C: Integer; @@ -44507,7 +44510,6 @@ begin PAnsiChar( S ) ) = 0;} end; -//[function TStrList.FindFirst] function TStrList.FindFirst(const S: AnsiString; var Index: Integer): Boolean; begin Result := Find( S, Index ); @@ -44520,9 +44522,7 @@ begin end; end; -//[procedure TStrList.Insert] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TStrList.Insert(Idx: integer; const S: Ansistring); var Mem: PAnsiChar; L: Integer; @@ -44539,15 +44539,12 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.Move] procedure TStrList.Move(CurIndex, NewIndex: integer); begin fList.MoveItem( CurIndex, NewIndex ); end; -//[procedure TStrList.Put] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TStrList.Put(Idx: integer; const Value: Ansistring); begin Delete( Idx ); @@ -44555,7 +44552,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.SetText] {$IFDEF ASM_TLIST} procedure TStrList.SetText(const S: Ansistring; Append2List: boolean); asm @@ -44696,7 +44692,6 @@ asm @@exit: end; {$ELSE ASM_VERSION} //Pascal -//[procedure TStrList.SetText] procedure TStrList.SetText(const S: Ansistring; Append2List: Boolean); var P, TheLast : PAnsiChar; @@ -44774,7 +44769,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.SetUnixText] procedure TStrList.SetUnixText(const S: AnsiString; Append2List: Boolean); var S1: AnsiString; begin @@ -44783,13 +44777,11 @@ begin SetText( S1, Append2List ); end; -//[procedure TStrList.SetTextStr] procedure TStrList.SetTextStr(const Value: Ansistring); begin SetText( Value, False ); end; -//[FUNCTION CompareStrListItems_NoCase] {$IFDEF ASM_TLIST} function CompareStrListItems_NoCase( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; asm @@ -44809,9 +44801,7 @@ begin Result := StrComp_NoCase( S1, S2 ); end; {$ENDIF ASM_VERSION} -//[END CompareStrListItems] -//[FUNCTION CompareStrListItems] {$IFDEF ASM_TLIST} function CompareStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; asm @@ -44831,9 +44821,7 @@ begin Result := StrComp( S1, S2 ); end; {$ENDIF ASM_VERSION} -//[END CompareStrListItems] -//[FUNCTION CompareAnsiStrListItems] {$IFDEF ASM_TLIST} function CompareAnsiStrListItems( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; asm @@ -44853,9 +44841,7 @@ begin Result := _AnsiCompareStrNoCaseA( S1, S2 ); end; {$ENDIF ASM_VERSION} -//[END CompareAnsiStrListItems] -//[FUNCTION CompareAnsiStrListItems_Case] {$IFDEF ASM_TLIST} function CompareAnsiStrListItems_Case( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; asm @@ -44875,19 +44861,15 @@ begin Result := _AnsiCompareStrA( S1, S2 ) end; {$ENDIF ASM_VERSION} -//[END CompareAnsiStrListItems] {$IFNDEF ASM_VERSION} -//[procedure SwapStrListItems] procedure SwapStrListItems( const Sender: Pointer; const e1, e2: DWORD ); begin PStrList( Sender ).Swap( e1, e2 ); end; {$ENDIF} -//[procedure TStrList.Sort] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TStrList.Sort(CaseSensitive: Boolean); begin fCaseSensitiveSort := CaseSensitive; @@ -44899,9 +44881,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.AnsiSort] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TStrList.AnsiSort(CaseSensitive: Boolean); begin fCaseSensitiveSort := CaseSensitive; @@ -44913,19 +44893,16 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.SortEx] procedure TStrList.SortEx(const CompareFun: TCompareEvent); begin SortData(@Self, fCount, CompareFun, {@SwapStrListItems}@TStrList.Swap); end; -//[procedure TStrList.Swap] procedure TStrList.Swap(Idx1, Idx2: Integer); begin fList.Swap( Idx1, Idx2 ); end; -//[function TStrList.Last] function TStrList.Last: AnsiString; begin if Count = 0 then @@ -44935,7 +44912,6 @@ begin end; //-- code by Dod: -//[function TStrList.IndexOfName] function TStrList.IndexOfName(AName: Ansistring): Integer; var i: Integer; @@ -44961,7 +44937,6 @@ begin end; //-- code by Dod: -//[function TStrList.GetValue] function TStrList.GetValue(const AName: Ansistring): Ansistring; var i: Integer; @@ -44973,7 +44948,6 @@ begin end; //-- code by Dod: -//[procedure TStrList.SetValue] procedure TStrList.SetValue(const AName, Value: Ansistring); var I: Integer; @@ -44984,30 +44958,31 @@ begin else Items[i] := AName + fNameDelim + Value; end; -//[function TStrList.GetLineName] function TStrList.GetLineName(Idx: Integer): AnsiString; -var s: KOLString; +var s: AnsiString; + Q: PAnsiChar; begin - s := Items[ Idx ]; - Result := Parse( s, AnsiString(fNameDelim) ); + s := ItemPtrs[ Idx ]; + Q := StrScan( PAnsiChar(s), '=' ); + Q^ := #0; + Result := PAnsiChar(s); end; -//[procedure TStrList.SetLineName] procedure TStrList.SetLineName(Idx: Integer; const NV: AnsiString); begin Items[ Idx ] := NV + fNameDelim + LineValue[ Idx ]; end; -//[function TStrList.GetLineValue] -function TStrList.GetLineValue(Idx: Integer): Ansistring; -var s: KOLString; +function TStrList.GetLineValue(Idx: Integer): AnsiString; +var Q: PAnsiChar; begin - s := Items[ Idx ]; - Parse( s, AnsiString(fNameDelim) ); - Result := s; + Q := ItemPtrs[ Idx ]; + Q := StrScan( Q, '=' ); + if Q <> nil then + inc( Q ); + Result := Q; end; -//[procedure TStrList.SetLineValue] procedure TStrList.SetLineValue(Idx: Integer; const Value: Ansistring); begin Items[ Idx ] := LineName[ Idx ] + fNameDelim + Value; @@ -45041,7 +45016,6 @@ end; {$IFDEF WIN_GDI} -//[function TStrList.AppendToFile] {$IFDEF ASM_UNICODE} function TStrList.AppendToFile(const FileName: Ansistring): Boolean; asm @@ -45094,7 +45068,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TStrList.LoadFromFile] {$IFDEF ASM_UNICODE} function TStrList.LoadFromFile(const FileName: AnsiString): Boolean; asm @@ -45161,7 +45134,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.LoadFromStream] {$IFDEF ASM_STREAM} procedure TStrList.LoadFromStream(Stream: PStream; Append2List: boolean); asm @@ -45213,9 +45185,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.MergeFromFile] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TStrList.MergeFromFile(const FileName: KOLString); var TmpStream: PStream; begin @@ -45225,7 +45195,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TStrList.SaveToFile] {$IFDEF ASM_UNICODE} function TStrList.SaveToFile(const FileName: Ansistring): Boolean; asm @@ -45278,9 +45247,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TStrList.SaveToStream] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TStrList.SaveToStream(Stream: PStream); var S: Ansistring; L: Integer; @@ -45295,8 +45262,6 @@ end; {$ENDIF WIN_GDI} ////////////////////////////////// EXTENDED STRING LIST OBJECT //////////////// -{-} -//[procedure WStrCopy] procedure WStrCopy( Dest, Src: PWideChar ); asm PUSH EDI @@ -45328,7 +45293,6 @@ begin end; end; -//[function WStrCmp] function WStrCmp( W1, W2: PWideChar ): Integer; asm PUSH ESI @@ -45349,31 +45313,30 @@ asm POP ESI end; +{$IFDEF _D3orHigher} function WStrCmp_NoCase( W1, W2: PWideChar ): Integer; begin Result := 0; - while (AnsiUpperCase( '' + W1^ ) = AnsiUpperCase( '' + W2^ )) do + while (WUpperCase( '' + W1^ ) = WUpperCase( '' + W2^ )) do begin if W1^ = #0 then Exit; inc( W1 ); inc( W2 ); end; Result := Integer(W1^) - Integer(W2^); -end;{ TStrListEx } +end; +{$ENDIF} + +{ TStrListEx } -//[function NewStrListEx] function NewStrListEx: PStrListEx; begin - {-} new( Result, Create ); - {+} - {++}(* - Result := PStrListEx.Create; - *){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TStrListEx'; + {$ENDIF} end; -//[END NewStrListEx] -//[destructor TStrListEx.Destroy] destructor TStrListEx.Destroy; var Obj: PList; begin @@ -45382,7 +45345,6 @@ begin Obj.Free; end; -//[function TStrListEx.GetObjects] function TStrListEx.GetObjects(Idx: Integer): DWORD; begin Result := 0; @@ -45390,33 +45352,28 @@ begin Result := DWORD( FObjects.Items[ Idx ] ); end; -//[function TStrListEx.GetObjectCount] function TStrListEx.GetObjectCount: Integer; begin Result := FObjects.Count; end; -//[procedure TStrListEx.SetObjects] procedure TStrListEx.SetObjects(Idx: Integer; const Value: DWORD); begin ProvideObjCapacity( Idx + 1 ); FObjects.Items[ Idx ] := Pointer( Value ); end; -//[procedure TStrListEx.Init] procedure TStrListEx.Init; begin inherited; FObjects := NewList; end; -//[procedure SwapStrListExItems] procedure SwapStrListExItems( const Sender: Pointer; const e1, e2: DWORD ); begin PStrListEx( Sender ).Swap( e1, e2 ); end; -//[procedure TStrListEx.AnsiSort] procedure TStrListEx.AnsiSort(CaseSensitive: Boolean); begin fCaseSensitiveSort := CaseSensitive; @@ -45427,7 +45384,6 @@ begin SortData( @Self, fCount, @CompareAnsiStrListItems, @SwapStrListExItems ) end; -//[procedure TStrListEx.Sort] procedure TStrListEx.Sort(CaseSensitive: Boolean); begin fCaseSensitiveSort := CaseSensitive; @@ -45438,7 +45394,6 @@ begin SortData( @Self, fCount, @CompareStrListItems_NoCase, @SwapStrListExItems ); end; -//[procedure TStrListEx.Move] procedure TStrListEx.Move(CurIndex, NewIndex: integer); begin // move string @@ -45451,7 +45406,6 @@ begin end; end; -//[procedure TStrListEx.Swap] procedure TStrListEx.Swap(Idx1, Idx2: Integer); begin // swap strings @@ -45464,7 +45418,6 @@ begin end; end; -//[procedure TStrListEx.ProvideObjCapacity] procedure TStrListEx.ProvideObjCapacity(NewCap: Integer); begin if FObjects.FCount < NewCap then @@ -45481,7 +45434,6 @@ begin end; end; -//[procedure TStrListEx.AddStrings] procedure TStrListEx.AddStrings(Strings: PStrListEx); var I: Integer; begin @@ -45503,21 +45455,18 @@ begin end; end; -//[procedure TStrListEx.Assign] procedure TStrListEx.Assign(Strings: PStrListEx); begin inherited Assign( Strings ); FObjects.Assign( Strings.FObjects ); end; -//[procedure TStrListEx.Clear] procedure TStrListEx.Clear; begin inherited; FObjects.Clear; end; -//[procedure TStrListEx.Delete] procedure TStrListEx.Delete(Idx: integer); begin inherited; @@ -45536,7 +45485,6 @@ begin end; -//[function TStrListEx.LastObj] function TStrListEx.LastObj: DWORD; begin if Count = 0 then @@ -45545,14 +45493,12 @@ begin Result := Objects[ Count - 1 ]; end; -//[function TStrListEx.AddObject] function TStrListEx.AddObject(const S: AnsiString; Obj: DWORD): Integer; begin Result := Count; InsertObject( Count, S, Obj ); end; -//[procedure TStrListEx.InsertObject] procedure TStrListEx.InsertObject(Before: Integer; const S: AnsiString; Obj: DWORD); begin Insert( Before, S ); @@ -45560,13 +45506,11 @@ begin FObjects.Insert( Before, Pointer( Obj ) ); end; -//[function TStrListEx.IndexOfObj] function TStrListEx.IndexOfObj( Obj: Pointer ): Integer; begin Result := FObjects.IndexOf( Obj ); end; -//[function WStrLen] function WStrLen( W: PWideChar ): Integer; asm XCHG EDI, EAX @@ -45606,28 +45550,27 @@ end; {$IFDEF WIN_GDI} {$IFNDEF _D2} -//[function NewWStrList] function NewWStrList: PWStrList; begin new( Result, Create ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TWStrList'; + {$ENDIF} end; { TWStrList } -//[function TWStrList.Add] function TWStrList.Add(const W: WideString): Integer; begin Result := Count; Insert( Result, W ); end; -//[procedure TWStrList.AddWStrings] procedure TWStrList.AddWStrings(WL: PWStrList); begin Text := Text + WL.Text; end; -//[function TWStrList.AppendToFile] function TWStrList.AppendToFile(const Filename: KOLString): Boolean; var Strm: PStream; begin @@ -45641,13 +45584,11 @@ begin Strm.Free; end; -//[procedure TWStrList.Assign] procedure TWStrList.Assign(WL: PWStrList); begin Text := WL.Text; end; -//[procedure TWStrList.Clear] procedure TWStrList.Clear; var I: Integer; P: Pointer; @@ -45666,7 +45607,6 @@ begin fList.Clear; end; -//[procedure TWStrList.Delete] procedure TWStrList.Delete(Idx: Integer); var P: Pointer; begin @@ -45677,7 +45617,6 @@ begin fList.Delete( Idx ); end; -//[destructor TWStrList.Destroy] destructor TWStrList.Destroy; begin Clear; @@ -45685,25 +45624,21 @@ begin inherited; end; -//[function TWStrList.GetCount] function TWStrList.GetCount: Integer; begin Result := fList.Count; end; -//[function TWStrList.GetItems] function TWStrList.GetItems(Idx: Integer): WideString; begin Result := PWideChar( fList.Items[ Idx ] ); end; -//[function TWStrList.GetPtrs] function TWStrList.GetPtrs(Idx: Integer): PWideChar; begin Result := fList.Items[ Idx ]; end; -//[function TWStrList.GetText] function TWStrList.GetText: WideString; const EoL: Array[ 0..5 ] of AnsiChar = ( #13, #0, #10, #0, #0, #0 ); // KOL_ANSI @@ -45735,13 +45670,11 @@ begin end; end; -//[procedure TWStrList.Init] procedure TWStrList.Init; begin fList := NewList; end; -//[procedure TWStrList.Insert] procedure TWStrList.Insert(Idx: Integer; const W: WideString); var P: Pointer; begin @@ -45752,14 +45685,12 @@ begin WStrCopy( P, PWideChar( W ) ); end; -//[function TWStrList.LoadFromFile] function TWStrList.LoadFromFile(const Filename: KOLString): Boolean; begin Clear; Result := MergeFromFile( Filename ); end; -//[procedure TWStrList.LoadFromStream] procedure TWStrList.LoadFromStream(Strm: PStream); begin Clear; @@ -45769,7 +45700,6 @@ end; const BOM : WideChar = #$FEFF; -//[function TWStrList.MergeFromFile] function TWStrList.MergeFromFile(const Filename: KOLString): Boolean; var Strm: PStream; DBOM: WideChar; @@ -45785,7 +45715,6 @@ begin Strm.Free; end; -//[procedure TWStrList.MergeFromStream] procedure TWStrList.MergeFromStream(Strm: PStream); var Buf: WideString; L: Integer; @@ -45800,20 +45729,17 @@ begin Text := Text + Buf; end; -//[procedure TWStrList.Move] procedure TWStrList.Move(IdxOld, IdxNew: Integer); begin fList.MoveItem( IdxOld, IdxNew ); end; -//[procedure TWStrList.Put] procedure TWStrList.Put(Idx: integer; const Value: WideString); begin Delete( Idx ); Insert( Idx, Value ); end; -//[function TWStrList.SaveToFile] function TWStrList.SaveToFile(const Filename: KOLString): Boolean; var Strm: PStream; DBOM: WideChar; @@ -45829,7 +45755,6 @@ begin Strm.Free; end; -//[procedure TWStrList.SaveToStream] procedure TWStrList.SaveToStream(Strm: PStream); var Buf, Dest: PWideChar; I, L, Sz: Integer; @@ -45864,7 +45789,6 @@ begin FreeMem( Buf ); end; -//[procedure TWStrList.SetItems] procedure TWStrList.SetItems(Idx: Integer; const Value: WideString); var P: Pointer; begin @@ -45884,7 +45808,6 @@ begin end; end; -//[procedure TWStrList.SetText] procedure TWStrList.SetText(const Value: WideString); var L, N: Integer; P: PWideChar; @@ -45929,7 +45852,6 @@ begin end; end; -//[function CompareWStrListItems] function CompareWStrListItems( const Sender: Pointer; const Idx1, Idx2: DWORD ): Integer; var WL: PWStrList; begin @@ -45937,7 +45859,6 @@ begin Result := WStrCmp( WL.fList.Items[ Idx1 ], WL.fList.Items[ Idx2 ] ); end; -//[function CompareWStrListItems_UpperCase] function CompareWStrListItems_UpperCase( const Sender: Pointer; const Idx1, Idx2: DWORD ): Integer; var WL: PWStrList; L1, L2, tL1, tL2: Integer; @@ -45964,7 +45885,6 @@ begin Result := WStrCmp( PWideChar( WL.fTmp1 ), PWideChar( WL.fTmp2 ) ); end; -//[procedure SwapWStrListItems] procedure SwapWStrListItems( const Sender: Pointer; const Idx1, Idx2: DWORD ); var WL: PWStrList; begin @@ -45972,7 +45892,6 @@ begin WL.Swap( Idx1, Idx2 ); end; -//[procedure TWStrList.Sort] procedure TWStrList.Sort( CaseSensitive: Boolean ); begin if CaseSensitive then @@ -45985,7 +45904,6 @@ begin end; end; -//[procedure TWStrList.Swap] procedure TWStrList.Swap(Idx1, Idx2: Integer); begin fList.Swap( Idx1, Idx2 ); @@ -46063,22 +45981,22 @@ begin else Result := Items[ Count-1 ]; end; -//[function NewWStrListEx] function NewWStrListEx: PWStrListEx; begin new( Result, Create ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TWStrListEx'; + {$ENDIF} end; { TWStrListEx } -//[function TWStrListEx.AddObject] function TWStrListEx.AddObject(const S: WideString; Obj: DWORD): Integer; begin Result := Count; InsertObject( Count, S, Obj ); end; -//[procedure TWStrListEx.AddWStrings] procedure TWStrListEx.AddWStrings(WL: PWStrListEx); var I: Integer; begin @@ -46103,21 +46021,18 @@ begin end; end; -//[procedure TWStrListEx.Assign] procedure TWStrListEx.Assign(WL: PWStrListEx); begin inherited Assign( WL ); FObjects.Assign( WL.FObjects ); end; -//[procedure TWStrListEx.Clear] procedure TWStrListEx.Clear; begin inherited Clear; FObjects.Clear; end; -//[procedure TWStrListEx.Delete] procedure TWStrListEx.Delete(Idx: Integer); begin inherited Delete( Idx ); @@ -46125,33 +46040,28 @@ begin FObjects.Delete( Idx ); end; -//[destructor TWStrListEx.Destroy] destructor TWStrListEx.Destroy; begin fObjects.Free; inherited; end; -//[function TWStrListEx.GetObjects] function TWStrListEx.GetObjects(Idx: Integer): DWORD; begin Result := DWORD( fObjects.Items[ Idx ] ); end; -//[function TWStrListEx.IndexOfObj] function TWStrListEx.IndexOfObj(Obj: Pointer): Integer; begin Result := FObjects.IndexOf( Obj ); end; -//[procedure TWStrListEx.Init] procedure TWStrListEx.Init; begin inherited; fObjects := NewList; end; -//[procedure TWStrListEx.InsertObject] procedure TWStrListEx.InsertObject(Before: Integer; const S: WideString; Obj: DWORD); begin @@ -46159,7 +46069,6 @@ begin FObjects.Insert( Before, Pointer( Obj ) ); end; -//[procedure TWStrListEx.Move] procedure TWStrListEx.Move(IdxOld, IdxNew: Integer); begin fList.MoveItem( IdxOld, IdxNew ); @@ -46170,7 +46079,6 @@ begin end; end; -//[procedure TWStrListEx.ProvideObjectsCapacity] procedure TWStrListEx.ProvideObjectsCapacity(NewCap: Integer); begin if fObjects.Capacity >= NewCap then Exit; @@ -46183,7 +46091,6 @@ begin {$ENDIF} end; -//[procedure TWStrListEx.SetObjects] procedure TWStrListEx.SetObjects(Idx: Integer; const Value: DWORD); begin ProvideObjectsCapacity( Idx + 1 ); @@ -46192,16 +46099,21 @@ end; {$ENDIF} {$ENDIF WIN_GDI} -{+} function NewKOLStrList: PKOLStrList; begin new( Result, Create ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TKOLStrList'; + {$ENDIF} end; function NewKOLStrListEx: PKOLStrListEx; begin new( Result, Create ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TKOLStrListEx'; + {$ENDIF} end; ////////////////////////////////////////////////////////////////////////// @@ -46209,204 +46121,7 @@ end; ////////////////////////////////////////////////////////////////////////// { -- qsort -- } -//[PROCEDURE SortData] -{$IFDEF ASM_VERSION} // translated to BASM by Kladov Vladimir -procedure SortData( const Data: Pointer; const uNElem: Dword; - const CompareFun: TCompareEvent; - const SwapProc: TSwapEvent ); -asm - CMP EDX, 2 - JL @@exit - - PUSH EAX // [EBP-4] = Data - PUSH ECX // [EBP-8] = CompareFun - PUSH EBX // EBX = pivotP - XOR EBX, EBX - INC EBX // EBX = 1 to pass to qSortHelp as PivotP - MOV EAX, EDX // EAX = nElem - CALL @@qSortHelp - POP EBX - POP ECX - POP ECX -@@exit: - POP EBP - RET 4 - -@@qSortHelp: - PUSH EBX // EBX (in) = PivotP - PUSH ESI // ESI = leftP - PUSH EDI // EDI = rightP - -@@TailRecursion: - CMP EAX, 2 - JG @@2 - JNE @@exit_qSortHelp - LEA ECX, [EBX+1] - MOV EDX, EBX - CALL @@Compare - JLE @@exit_qSortHelp -@@swp_exit: - CALL @@Swap -@@exit_qSortHelp: - POP EDI - POP ESI - POP EBX - RET - - // ESI = leftP - // EDI = rightP -@@2: LEA EDI, [EAX+EBX-1] - MOV ESI, EAX - SHR ESI, 1 - ADD ESI, EBX - MOV ECX, ESI - MOV EDX, EDI - CALL @@CompareLeSwap - MOV EDX, EBX - CALL @@Compare - - JG @@4 - CALL @@Swap - JMP @@5 -@@4: MOV ECX, EBX - MOV EDX, EDI - CALL @@CompareLeSwap -@@5: - CMP EAX, 3 - JNE @@6 - MOV EDX, EBX - MOV ECX, ESI - JMP @@swp_exit -@@6: // classic Horae algorithm - - PUSH EAX // EAX = pivotEnd - LEA EAX, [EBX+1] - MOV ESI, EAX -@@repeat: - MOV EDX, ESI - MOV ECX, EBX - CALL @@Compare - JG @@while2 -@@while1: - JNE @@7 - MOV EDX, ESI - MOV ECX, EAX - CALL @@Swap - INC EAX -@@7: - CMP ESI, EDI - JGE @@qBreak - INC ESI - JMP @@repeat -@@while2: - CMP ESI, EDI - JGE @@until - MOV EDX, EBX - MOV ECX, EDI - CALL @@Compare - JGE @@8 - DEC EDI - JMP @@while2 -@@8: - MOV EDX, ESI - MOV ECX, EDI - PUSHFD - CALL @@Swap - POPFD - JE @@until - INC ESI - DEC EDI -@@until: - CMP ESI, EDI - JL @@repeat -@@qBreak: - MOV EDX, ESI - MOV ECX, EBX - CALL @@Compare - JG @@9 - INC ESI -@@9: - PUSH EBX // EBX = PivotTemp - PUSH ESI // ESI = leftTemp - DEC ESI -@@while3: - CMP EBX, EAX - JGE @@while3_break - CMP ESI, EAX - JL @@while3_break - MOV EDX, EBX - MOV ECX, ESI - CALL @@Swap - INC EBX - DEC ESI - JMP @@while3 -@@while3_break: - POP ESI - POP EBX - - MOV EDX, EAX - POP EAX // EAX = nElem - PUSH EDI // EDI = lNum - MOV EDI, ESI - SUB EDI, EDX - ADD EAX, EBX - SUB EAX, ESI - - PUSH EBX - PUSH EAX - CMP EAX, EDI - JGE @@10 - - MOV EBX, ESI - CALL @@qSortHelp - POP EAX - MOV EAX, EDI - POP EBX - JMP @@11 - -@@10: MOV EAX, EDI - CALL @@qSortHelp - POP EAX - POP EBX - MOV EBX, ESI -@@11: - POP EDI - JMP @@TailRecursion - -@@Compare: - PUSH EAX - PUSH EDX - PUSH ECX - MOV EAX, [EBP-4] - DEC EDX - DEC ECX - CALL dword ptr [EBP-8] - POP ECX - POP EDX - TEST EAX, EAX - POP EAX - RET - -@@CompareLeSwap: - CALL @@Compare - JG @@ret - -@@Swap: PUSH EAX - PUSH EDX - PUSH ECX - MOV EAX, [EBP-4] - DEC EDX - DEC ECX - CALL dword ptr [SwapProc] - POP ECX - POP EDX - TEST EAX, EAX - POP EAX -@@ret: - RET - -end; -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure SortData( const Data: Pointer; const uNElem: Dword; const CompareFun: TCompareEvent; const SwapProc: TSwapEvent ); @@ -46533,11 +46248,8 @@ begin qSortHelp(1, uNElem); end; {$ENDIF ASM_VERSION} -//[END SortData] -//[FUNCTION CompareIntegers] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function CompareIntegers( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; var I1, I2 : Integer; begin @@ -46549,11 +46261,8 @@ begin if I1 > I2 then Result := 1; end; {$ENDIF ASM_VERSION} -//[END CompareIntegers] -//[FUNCTION CompareDwords] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function CompareDwords( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; var I1, I2 : DWord; begin @@ -46565,11 +46274,8 @@ begin if I1 > I2 then Result := 1; end; {$ENDIF ASM_VERSION} -//[END CompareDwords] -//[PROCEDURE SwapIntegers] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure SwapIntegers( const Sender : Pointer; const e1, e2 : DWORD ); var Tmp : Integer; begin @@ -46579,9 +46285,7 @@ begin PInteger( DWORD( Sender ) + e2 * Sizeof( Integer ) )^ := Tmp; end; {$ENDIF ASM_VERSION} -//[END SwapIntegers] -//[procedure SortIntegerArray] procedure SortIntegerArray( var A : array of Integer ); begin SortData( @A[ 0 ], High( A ) - Low( A ) + 1, @CompareIntegers, @SwapIntegers ); @@ -46592,7 +46296,6 @@ begin PList( L ).Swap( e1, e2 ); end; -//[procedure SortDwordArray] procedure SortDwordArray( var A : array of DWORD ); begin SortData( @A[ 0 ], High( A ) - Low( A ) + 1, @CompareDwords, @SwapIntegers ); @@ -46601,8 +46304,49 @@ end; { -- status bar implementation -- } -//[FUNCTION _NewStatusbar] {$IFDEF ASM_VERSION} +function _NewStatusbar( AParent: PControl ): PControl; +const STAT_CLS_NAM: PKOLChar = STATUSCLASSNAME; +asm + PUSH 0 + {$IFDEF COMMANDACTIONS_OBJ} + PUSH OTHER_ACTIONS + {$ELSE} + PUSH 0 + {$ENDIF} + {$IFDEF USE_FLAGS} + TEST [EAX].TControl.fFlagsG3, (1 shl G3_SizeGrip) + {$ELSE} + CMP [EAX].TControl.fSizeGrip, 0 + {$ENDIF} + MOV ECX, WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or 3 or WS_VISIBLE + JZ @@1 + INC CH + AND CL, not 3 +@@1: + MOV EDX, [STAT_CLS_NAM] + CALL _NewCommonControl + PUSH EBX + XCHG EBX, EAX + PUSH EDI + LEA EDI, [EBX].TControl.fBoundsRect + XOR EAX, EAX + STOSD + STOSD + STOSD + STOSD + MOV [EBX].TControl.fAlign, caBottom + {$IFDEF USE_FLAGS} + OR [EBX].TControl.fFlagsG4, 1 shl G4_NotUseAlign + {$ELSE} + INC [EBX].TControl.fNotUseAlign + {$ENDIF} + POP EDI + MOV EAX, EBX + CALL InitCommonControlSizeNotify + XCHG EAX, EBX + POP EBX +end; {$ELSE ASM_VERSION} //Pascal function _NewStatusbar( AParent: PControl ): PControl; var Style: DWORD; @@ -46610,11 +46354,16 @@ begin Style := WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or 3 or WS_VISIBLE; {if AParent.CanResize then Style := Style or SBARS_SIZEGRIP;} - if AParent.fSizeGrip then - Style := (Style or SBARS_SIZEGRIP) and not 3; + if {$IFDEF USE_FLAGS} G3_SizeGrip in AParent.fFlagsG3 + {$ELSE} AParent.fSizeGrip {$ENDIF} then + Style := (Style or SBARS_SIZEGRIP) and not 3; Result := _NewCommonControl( AParent, STATUSCLASSNAME, - Style, FALSE, nil ); - + Style, FALSE, + {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS ) + {$ELSE} nil {$ENDIF} ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:StatusBar'; + {$ENDIF} with Result.fBoundsRect do begin Left := 0; @@ -46623,38 +46372,131 @@ begin Bottom := 0; end; Result.fAlign := caBottom; - Result.fNotUseAlign := True; + {$IFDEF USE_FLAGS} include( Result.fFlagsG4, G4_NotUseAlign ); + {$ELSE} Result.fNotUseAlign := True; {$ENDIF} {$IFDEF TEST_VERSION} Result.fTag := DWORD( PAnsiChar( 'Status bar' ) ); {$ENDIF} InitCommonControlSizeNotify( Result ); end; {$ENDIF ASM_VERSION} -//[END _NewStatusbar] -//[procedure TControl.SetStatusText] -{$IFDEF ASM_VERSION} +{$IFDEF ASM_UNICODE} +procedure TControl.SetStatusText(Index: Integer; const Value: KOLString); +asm + PUSHAD + MOV EBX, EDX // EBX = Index + MOV ESI, EAX // ESI = @Self + PUSH Value // prepare value for call at the end of procedure + PUSH EBX // prepare Index for call at the end of procedure + MOV ECX, [ESI].fStatusCtl + MOV EBP, ECX + INC ECX + LOOP @@status_created + CALL GetClientHeight + PUSH EAX // ch = old client height + MOV EAX, ESI + CALL _NewStatusBar + MOV [ESI].fStatusCtl, EAX + XCHG EBP, EAX + XOR EDX, EDX + PUSH EDX + INC DH + DEC EDX + CMP EBX, EDX + SETZ DL + NEG EDX + PUSH EDX + PUSH SB_SIMPLE + PUSH EBP + CALL TControl.Perform + ADD ESP, -16 + PUSH ESP + PUSH [EBP].fHandle + CALL GetWindowRect + POP EAX + POP EDX + POP EAX + POP EAX + SUB EAX, EDX + MOV [ESI].fClientBottom, AL + POP EDX // ch + PUSH 0 + PUSH 0 + PUSH WM_SIZE + PUSH EBP + MOV EAX, ESI + CALL TControl.SetClientHeight + CALL TControl.Perform +@@status_created: + CMP EBX, 255 + JGE @@not_simple + PUSH 0 + PUSH 0 + PUSH SB_GETPARTS + PUSH EBP + CALL Perform + CMP EAX, EBX + JG @@reset_simple + MOV EAX, ESI + CALL GetWidth + CDQ + MOV ECX, EBX + INC ECX + IDIV ECX + MOV EDX, EAX + ADD ESP, -1024 + /////////////////// + MOV ECX, EBX + MOV EDI, ESP + JECXZ @@2 +@@store_loo: + STOSD + ADD EAX, EDX + LOOP @@store_loo +@@2: + OR dword ptr [ESP+EBX*4], -1 + PUSH ESP + INC EBX + PUSH EBX + PUSH SB_SETPARTS + PUSH EBP + CALL Perform + //////////////////// + ADD ESP, 1024 +@@reset_simple: + PUSH 0 + PUSH 0 + PUSH SB_SIMPLE + PUSH EBP + CALL Perform +@@not_simple: + PUSH SB_SETTEXT + PUSH EBP + CALL Perform + POPAD +end; {$ELSE ASM_VERSION} //Pascal -procedure TControl.SetStatusText(Index: Integer; Value: PKOLChar); +procedure TControl.SetStatusText(Index: Integer; const Value: KOLString); var ch: Integer; R : TRect; N, I, L, W : Integer; WidthsBuf: array[ 0..254 ] of Integer; + Val: Integer; begin if fStatusCtl = nil then begin ch := GetClientHeight; fStatusCtl := _NewStatusBar( @Self ); - fStatusWnd := fStatusCtl.GetWindowHandle; fStatusCtl.Perform( SB_SIMPLE, Integer( LongBool( Index = 255 ) ), 0 ); - GetWindowRect( fStatusWnd, R ); + GetWindowRect( {fStatusWnd}fStatusCtl.fHandle, R ); fClientBottom := R.Bottom - R.Top; SetClientHeight( ch ); - SendMessage( fStatusWnd, WM_SIZE, 0, 0 ); + fStatusCtl.Perform( WM_SIZE, 0, 0 ); end; if Index < 255 then begin - N := SendMessage( fStatusWnd, SB_GETPARTS, 0, 0 ); + N := fStatusCtl.Perform( SB_GETPARTS, 0, 0 ); if N <= Index then begin W := Width; @@ -46666,27 +46508,85 @@ begin Inc( W, L ); end; WidthsBuf[ Index ] := -1; - SendMessage( fStatusWnd, SB_SETPARTS, Index + 1, Integer( @WidthsBuf[ 0 ] ) ); + fStatusCtl.Perform( SB_SETPARTS, Index + 1, Integer( @WidthsBuf[ 0 ] ) ); end; - SendMessage( fStatusWnd, SB_SIMPLE, 0, 0 ); + fStatusCtl.Perform( SB_SIMPLE, 0, 0 ); end; - SendMessage( fStatusWnd, - {$IFDEF UNICODE_CTRLS} SB_SETTEXTW {$ELSE} SB_SETTEXT {$ENDIF}, Index, Integer( Value ) ); + Val := 0; + if Value <> '' then + Val := Integer( @ Value[1] ); + fStatusCtl.Perform( + {$IFDEF UNICODE_CTRLS} SB_SETTEXTW {$ELSE} SB_SETTEXT {$ENDIF}, Index, Val ); end; {$ENDIF ASM_VERSION} -//[function TControl.GetStatusText] -{$IFDEF ASM_VERSION} +{$IFDEF noASM_UNICODE} +function TControl.GetStatusText( Index: Integer ): KOLString; +asm + MOV ECX, [EAX].fStatusCtl + JECXZ @@exit + + PUSH EBX + PUSH ESI + XCHG ESI, EAX // ESI = @Self + MOV EBX, EDX // EBX = Index + + XOR EAX, EAX + XCHG EAX, [ESI].fStatusTxt + TEST EAX, EAX + JZ @@1 + CALL System.@FreeMem +@@1: + XOR EAX, EAX + CDQ + MOV DL, WM_GETTEXTLENGTH + PUSH WM_GETTEXT + CMP EBX, 255 + JZ @@2 + POP EAX + MOV EAX, EBX + MOV DX, SB_GETTEXTLENGTH + PUSH SB_GETTEXT +@@2: + MOV EBX, EAX + + PUSH 0 + PUSH EAX + PUSH EDX + PUSH [ESI].fStatusCtl + CALL Perform + TEST AX, AX + JZ @@get_rslt + + PUSH EAX + INC EAX + CALL System.@GetMem + POP EDX + MOV [ESI].fStatusTxt, EAX + MOV byte ptr [EAX+EDX], 0 + + POP EDX // Msg + PUSH EAX + PUSH EBX + PUSH EDX + PUSH [ESI].fStatusCtl + CALL Perform + PUSH EDX +@@get_rslt: + POP EDX + MOV ECX, [ESI].fStatusTxt + POP ESI + POP EBX + +@@exit: XCHG EAX, ECX +end; {$ELSE ASM_VERSION} //Pascal -function TControl.GetStatusText( Index: Integer ): PKOLChar; +function TControl.GetStatusText( Index: Integer ): KOLString; var L, I: Integer; Msg: DWORD; begin - Result := nil; - if fStatusWnd = 0 then Exit; - if fStatusTxt <> nil then - FreeMem( fStatusTxt ); - fStatusTxt := nil; + Result := ''; + if fStatusCtl = nil then Exit; Msg := SB_GETTEXTLENGTH; I := Index; if Index = 255 then @@ -46694,29 +46594,27 @@ begin Msg := WM_GETTEXTLENGTH; I := 0; end; - L := SendMessage( fStatusWnd, Msg, I, 0 ) and $FFFF; + L := //SendMessage( fStatusWnd, Msg, I, 0 ) and $FFFF; + fStatusCtl.Perform( Msg, I, 0 ) and $FFFF; if L > 0 then begin - GetMem( fStatusTxt, (L + 1)*Sizeof(KOLChar) ); - fStatusTxt[ L ] := #0; + SetLength( Result, L ); Msg := {$IFDEF UNICODE_CTRLS} SB_GETTEXTW {$ELSE} SB_GETTEXT {$ENDIF}; - if Index = 255 then - Msg := WM_GETTEXT; - SendMessage( fStatusWnd, Msg, I, Integer( fStatusTxt ) ); + if Index = 255 then + Msg := WM_GETTEXT; + fStatusCtl.Perform( Msg, I, Integer( @ Result[1] ) ); end; - Result := fStatusTxt; + //Result := fStatusTxt; end; {$ENDIF ASM_VERSION} -//[procedure TControl.RemoveStatus] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.RemoveStatus; var ch: Integer; begin if fStatusCtl = nil then Exit; ch := ClientHeight; - fStatusWnd := 0; + //fStatusWnd := 0; fStatusCtl.Free; fStatusCtl := nil; fClientBottom := 0; @@ -46724,94 +46622,90 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.StatusPanelCount] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.StatusPanelCount: Integer; begin Result := 0; - if fStatusWnd = 0 then Exit; - Result := SendMessage( fStatusWnd, SB_GETPARTS, 0, 0 ); + //if fStatusWnd = 0 then Exit; + if fStatusCtl = nil then Exit; + Result := //SendMessage( fStatusWnd, SB_GETPARTS, 0, 0 ); + fStatusCtl.Perform( SB_GETPARTS, 0, 0 ); end; {$ENDIF ASM_VERSION} -//[function TControl.GetStatusPanelX] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetStatusPanelX(Idx: Integer): Integer; var Buf: array[0..254] of Integer; N : Integer; begin Result := 0; - if fStatusWnd = 0 then Exit; - N := SendMessage( fStatusWnd, SB_GETPARTS, 255, Integer( @Buf[ 0 ] ) ); + //if fStatusWnd = 0 then Exit; + if fStatusCtl = nil then Exit; + N := //SendMessage( fStatusWnd, SB_GETPARTS, 255, Integer( @Buf[ 0 ] ) ); + fStatusCtl.Perform( SB_GETPARTS, 255, Integer( @Buf[ 0 ] ) ); if N <= Idx then Exit; Result := Buf[ Idx ]; end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetStatusPanelX] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetStatusPanelX(Idx: Integer; const Value: Integer); var Buf: array[0..254] of Integer; N : Integer; begin - if fStatusWnd = 0 then Exit; - N := SendMessage( fStatusWnd, SB_GETPARTS, 255, Integer( @Buf[ 0 ] ) ); + //if fStatusWnd = 0 then Exit; + if fStatusCtl = nil then Exit; + N := //SendMessage( fStatusWnd, SB_GETPARTS, 255, Integer( @Buf[ 0 ] ) ); + fStatusCtl.Perform( SB_GETPARTS, 255, Integer( @Buf[ 0 ] ) ); if N <= Idx then Exit; Buf[ Idx ] := Value; - SendMessage( fStatusWnd, SB_SETPARTS, N, Integer( @Buf[ 0 ] ) ); + //SendMessage( fStatusWnd, SB_SETPARTS, N, Integer( @Buf[ 0 ] ) ); + fStatusCtl.Perform( SB_SETPARTS, N, Integer( @Buf[ 0 ] ) ); end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetColor1] procedure TControl.SetColor1(const Value: TColor); begin - fColor1 := Value; + DF.fColor1 := Value; Invalidate; end; -//[procedure TControl.SetColor2] procedure TControl.SetColor2(const Value: TColor); begin - fColor2 := Value; + DF.fColor2 := Value; Invalidate; end; -//[procedure TControl.SetGradientLayout] procedure TControl.SetGradientLayout(const Value: TGradientLayout); begin - FGradientLayout := Value; + DF.fGradientLayout := Value; Invalidate; end; -//[procedure TControl.SetGradientStyle] procedure TControl.SetGradientStyle(const Value: TGradientStyle); begin - FGradientStyle := Value; + DF.fGradientStyle := Value; Invalidate; end; { -- Image List -- } -//* {$IFDEF USE_CONSTRUCTORS} -//[function NewImageList] function NewImageList( AOwner: PControl ): PImageList; begin new( Result, CreateImageList( AOwner ) ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TImageList'; + {$ENDIF} end; -//[END NewImageList] {$ELSE not_USE_CONSTRUCTORS} -//[function NewImageList] function NewImageList( AOwner: PControl ): PImageList; begin {*************} DoInitCommonControls( ICC_WIN95_CLASSES ); - {-} New( Result, Create ); - {+} - {++}(*Result := TImageList.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TImageList'; + {$ENDIF} Result.FAllocBy := 1; Result.FMasked := True; Result.fBkColor := clNone; @@ -46832,7 +46726,6 @@ begin end; {$ENDIF} -//[API ImageList_XXX] function ImageList_Create; stdcall; external cctrl name 'ImageList_Create'; function ImageList_Destroy; external cctrl name 'ImageList_Destroy'; function ImageList_GetImageCount; external cctrl name 'ImageList_GetImageCount'; @@ -46866,46 +46759,39 @@ function ImageList_SetIconSize; external cctrl name 'ImageList_SetIconSize'; function ImageList_GetImageInfo; external cctrl name 'ImageList_GetImageInfo'; function ImageList_Merge; external cctrl name 'ImageList_Merge'; -//[function ImageList_AddIcon] function ImageList_AddIcon(ImageList: HImageList; Icon: HIcon): Integer; begin Result := ImageList_ReplaceIcon(ImageList, -1, Icon); end; -//[function Index2OverlayMask] function Index2OverlayMask(Index: Integer): Integer; begin Result := Index shl 8; end; { macros } -//[procedure ImageList_RemoveAll] procedure ImageList_RemoveAll(ImageList: HImageList); stdcall; begin ImageList_Remove(ImageList, -1); end; -//[function ImageList_ExtractIcon] function ImageList_ExtractIcon(Instance: THandle; ImageList: HImageList; Image: Integer): HIcon; stdcall; begin Result := ImageList_GetIcon(ImageList, Image, 0); end; -//[function ImageList_LoadBitmap] function ImageList_LoadBitmap(Instance: THandle; Bmp: PKOLChar; CX, Grow: Integer; Mask: TColorRef): HImageList; stdcall; begin Result := ImageList_LoadImage(Instance, Bmp, CX, Grow, Mask, IMAGE_BITMAP, 0); end; -//[procedure FreeBmp] procedure FreeBmp( Bmp: HBitmap ); begin DeleteObject( Bmp ); end; -//[function LoadBmp] function LoadBmp( Instance: Integer; Rsrc: PKOLChar; MasterObj: PObj ): HBitmap; begin Result := LoadBitmap( Instance, Rsrc ); @@ -46914,8 +46800,6 @@ end; { TImageList } -//* -//[function TImageList.Add] function TImageList.Add(Bmp, Msk: HBitmap): Integer; begin Result := -1; @@ -46923,8 +46807,6 @@ begin Result := ImageList_Add( FHandle, Bmp, Msk ); end; -//* -//[function TImageList.AddIcon] function TImageList.AddIcon(Ico: HIcon): Integer; {var Bmp : HBitmap; DC : HDC;} @@ -46938,8 +46820,6 @@ begin Result := ImageList_AddIcon( fHandle, Ico ); end; -//* -//[function TImageList.AddMasked] function TImageList.AddMasked(Bmp: HBitmap; Color: TColor): Integer; begin Result := -1; @@ -46947,24 +46827,18 @@ begin Result := ImageList_AddMasked( FHandle, Bmp, Color2RGB( Color ) ); end; -//+ -//[procedure TImageList.Clear] procedure TImageList.Clear; begin Handle := 0; end; -//* -//[procedure TImageList.Delete] procedure TImageList.Delete(Idx: Integer); begin if FHandle = 0 then Exit; ImageList_Remove( FHandle, Idx ); end; -//[destructor TImageList.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TImageList.Destroy; begin Clear; @@ -46984,28 +46858,22 @@ begin end; {$ENDIF ASM_VERSION} -//* -//[procedure TImageList.Draw] procedure TImageList.Draw(Idx: Integer; DC: HDC; X, Y: Integer); begin if FHandle = 0 then Exit; ImageList_Draw( FHandle, Idx, DC, X, Y, GetDrawStyle ); end; -//[function TImageList.ExtractIcon] function TImageList.ExtractIcon(Idx: Integer): HIcon; begin Result := ImageList_ExtractIcon( 0, FHandle, Idx ); end; -//[function TImageList.ExtractIconEx] function TImageList.ExtractIconEx(Idx: Integer): HIcon; begin Result := ImageList_GetIcon( FHandle, Idx, GetDrawStyle ); end; -//* -//[function TImageList.GetBitmap] function TImageList.GetBitmap: HBitmap; var II : TImageInfo; begin @@ -47015,8 +46883,6 @@ begin Result := II.hbmImage; end; -//* -//[function TImageList.GetBkColor] function TImageList.GetBkColor: TColor; begin Result := fBkColor; @@ -47024,8 +46890,6 @@ begin Result := ImageList_GetBkColor( FHandle ); end; -//* -//[function TImageList.GetCount] function TImageList.GetCount: Integer; begin Result := 0; @@ -47033,8 +46897,6 @@ begin Result := ImageList_GetImageCount( FHandle ); end; -//* -//[function TImageList.GetDrawStyle] function TImageList.GetDrawStyle: DWord; begin Result := 0; @@ -47051,9 +46913,7 @@ begin Result := Result or ILD_NORMAL}; // ILD_NORMAL = 0 end; -//[function TImageList.GetHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TImageList.GetHandle: THandle; begin HandleNeeded; @@ -47061,8 +46921,6 @@ begin end; {$ENDIF ASM_VERSION} -//* -//[function TImageList.GetMask] function TImageList.GetMask: HBitmap; var II : TImageInfo; begin @@ -47073,7 +46931,6 @@ begin end; {$IFDEF ASM_noVERSION} -//[function TImageList.HandleNeeded] function TImageList.HandleNeeded: Boolean; const ColorFlags : array[ TImageListColors ] of Byte = ( ILC_COLOR, ILC_COLOR4, ILC_COLOR8, ILC_COLOR16, ILC_COLOR24, @@ -47133,8 +46990,6 @@ begin end; {$ENDIF ASM_VERSION} -//* -//[function TImageList.ImgRect] function TImageList.ImgRect(Idx: Integer): TRect; var II : TImageInfo; begin @@ -47145,7 +47000,6 @@ begin end; {$IFDEF ASM_noVERSION_UNICODE} -//[function TImageList.LoadBitmap] function TImageList.LoadBitmap(ResourceName: PAnsiChar; TranspColor: TColor): Boolean; asm @@ -47194,8 +47048,6 @@ begin end; {$ENDIF ASM_VERSION} -//* -//[function TImageList.LoadFromFile] function TImageList.LoadFromFile(FileName: PKOLChar; TranspColor: TColor; ImgType: TImageType): Boolean; const ImgTypes:array[ TImageType ] of DWord = ( IMAGE_BITMAP, IMAGE_ICON, IMAGE_CURSOR ); @@ -47213,8 +47065,6 @@ begin Handle := NewHandle; end; -//* -//[function TImageList.LoadSystemIcons] function TImageList.LoadSystemIcons(SmallIcons: Boolean): Boolean; var NewHandle : THandle; FileInfo : TSHFileInfo; @@ -47234,8 +47084,6 @@ begin end; end; -//* -//[function TImageList.Merge] function TImageList.Merge(Idx: Integer; ImgList2: PImageList; Idx2, X, Y: Integer): PImageList; var L : THandle; @@ -47250,8 +47098,6 @@ begin end; end; -//* -//[function TImageList.Replace] function TImageList.Replace(Idx: Integer; Bmp, Msk: HBitmap): Boolean; begin Result := False; @@ -47259,8 +47105,6 @@ begin Result := ImageList_Replace( FHandle, Idx, Bmp, Msk ); end; -//* -//[function TImageList.ReplaceIcon] function TImageList.ReplaceIcon(Idx: Integer; Ico: HIcon): Boolean; begin Result := False; @@ -47268,8 +47112,6 @@ begin Result := ImageList_ReplaceIcon( FHandle, Idx, Ico ) >= 0; end; -//* -//[procedure TImageList.SetAllocBy] procedure TImageList.SetAllocBy(const Value: Integer); begin if FHandle <> 0 then Exit; @@ -47278,8 +47120,6 @@ begin FAllocBy := Value; end; -//* -//[procedure TImageList.SetBkColor] procedure TImageList.SetBkColor(const Value: TColor); begin fBkColor := Value; @@ -47287,17 +47127,13 @@ begin ImageList_SetBkColor( FHandle, Color2RGB( Value ) ); end; -//* -//[procedure TImageList.SetColors] procedure TImageList.SetColors(const Value: TImageListColors); begin if FHandle <> 0 then Exit; FColors := Value; end; -//[procedure TImageList.SetHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TImageList.SetHandle(const Value: THandle); begin if FHandle = Value then Exit; @@ -47315,42 +47151,35 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TImageList.SetImgHeight] procedure TImageList.SetImgHeight(const Value: Integer); begin if FHandle <> 0 then Exit; FImgHeight := Value; end; -//[procedure TImageList.SetImgWidth] procedure TImageList.SetImgWidth(const Value: Integer); begin if FHandle <> 0 then Exit; FImgWidth := Value; end; -//[procedure TImageList.SetMasked] procedure TImageList.SetMasked(const Value: Boolean); begin if FHandle <> 0 then Exit; FMasked := Value; end; -//* -//[function TImageList.GetOverlay] function TImageList.GetOverlay(Idx: TImgLOVrlayIdx): Integer; begin Result := fOverlay[ Idx ]; end; -//[procedure TImageList.SetOverlay] procedure TImageList.SetOverlay(Idx: TImgLOVrlayIdx; const Value: Integer); begin if ImageList_SetOverlayImage( fHandle, Value, Idx shl 8 ) then fOverlay[ Idx ] := Value; end; -//[procedure TImageList.StretchDraw] procedure TImageList.StretchDraw(Idx: Integer; DC: HDC; const Rect: TRect); begin if FHandle = 0 then Exit; @@ -47359,59 +47188,51 @@ begin BkColor, BlendColor, GetDrawStyle ); end; -//* -//[function GetImgListSize] function GetImgListSize( Sender: PControl; Size: Integer ): PImageList; begin - if Size > 16 then - Result := Sender.fCtlImageListNormal + if Size > 16 then + Result := Sender.DF.fCtlImageListNormal else - Result := Sender.fCtlImageListSml; - if Result <> nil then + Result := Sender.DF.fCtlImageListSml; + if Result <> nil then begin - if Result.fImgWidth = 0 then - Result.ImgWidth := Size; - if Result.fImgHeight = 0 then - Result.ImgHeight := Size; - //if (Result.FImgWidth <> Size) or (Result.FImgHeight <> Size) then - // Result := nil; + if Result.fImgWidth = 0 then + Result.ImgWidth := Size; + if Result.fImgHeight = 0 then + Result.ImgHeight := Size; end; - if Result = nil then + if Result = nil then begin - Result := Sender.fImageList; - while Result <> nil do - begin - if (Result.FImgWidth = Size) and (Result.FImgHeight = Size) then - break; - Result := Result.fNext; - end; - end; -end; - -//* -//[function TControl.GetImgListIdx] -function TControl.GetImgListIdx(const Index: Integer): PImageList; -begin - if Index <> 0 then - Result := GetImgListSize( @Self, Index ) - else - begin - Result := fCtlImgListState; - if Result = nil then - begin - Result := fImageList; + Result := Sender.fImageList; while Result <> nil do begin - if (Result <> GetImgListIdx( 16 )) and (Result <> GetImgListIdx( 32 )) then - break; - Result := Result.fNext; + if (Result.FImgWidth = Size) and (Result.FImgHeight = Size) then + break; + Result := Result.fNext; + end; + end; +end; + +function TControl.GetImgListIdx(const Index: Integer): PImageList; +begin + if Index <> 0 then + Result := GetImgListSize( @Self, Index ) + else + begin + Result := DF.fCtlImgListState; + if Result = nil then + begin + Result := fImageList; + while Result <> nil do + begin + if (Result <> GetImgListIdx( 16 )) and (Result <> GetImgListIdx( 32 )) then + break; + Result := Result.fNext; + end; end; - end; end; end; -//* -//[procedure TControl.SetImgListIdx] procedure TControl.SetImgListIdx(const Index: Integer; const Value: PImageList); begin @@ -47427,16 +47248,15 @@ begin end; case Index of - 32: fCtlImageListNormal := Value; - 16: fCtlImageListSml := Value; - else fCtlImgListState := Value; + 32: DF.fCtlImageListNormal := Value; + 16: DF.fCtlImageListSml := Value; + else DF.fCtlImgListState := Value; end; ApplyImageLists2Control( @Self ); end; { -- list view -- } -//[function WndProcEndLabelEdit] function WndProcEndLabelEdit( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var NMhdr: PNMHdr; LVDisp: PLVDispInfo; @@ -47453,58 +47273,56 @@ begin Result := True; if LVDisp.item.pszText = nil then Exit; Rslt := 1; - if assigned( Self_.fOnEndEditLVItem ) then + {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnEndEditLVItem ) then + {$ENDIF} begin - Flag := Self_.fOnEndEditLVItem( Self_, LVDisp.item.iItem, - LVDisp.item.iSubItem, LVDisp.item.pszText ); - if Flag then Rslt := 1 - else Rslt := 0; + Flag := Self_.EV.fOnEndEditLVItem( Self_, LVDisp.item.iItem, + LVDisp.item.iSubItem, LVDisp.item.pszText ); + if Flag then Rslt := 1 + else Rslt := 0; end; end; end; end; end; -//[procedure TControl.SetOnEndEditLVItem] procedure TControl.SetOnEndEditLVItem(const Value: TOnEditLVItem); begin - fOnEndEditLVITem := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnEndEditLVITem := Value; AttachProc( WndProcEndLabelEdit ); end; -//* -//[procedure TControl.LVColAdd] procedure TControl.LVColAdd(const aText: KOLString; aalign: TTextAlign; aWidth: Integer); begin - LVColInsert( fLVColCount, aText, aalign, aWidth );// 21.10.2001 + LVColInsert( DF.fLVColCount, aText, aalign, aWidth );// 21.10.2001 end; //****************** changed by Mike Gerasimov -//[procedure TControl.LVColInsert] procedure TControl.LVColInsert(ColIdx: Integer; const aText: KOLString; aAlign: TTextAlign; aWidth: Integer); var LVColData: TLVColumn; begin LVColData.mask := LVCF_FMT or LVCF_TEXT; - if ImageListSmall <> nil then - LVColData.mask := LVColData.mask; // or LVCF_IMAGE ; + if ImageListSmall <> nil then + LVColData.mask := LVColData.mask; // or LVCF_IMAGE ; LVColData.iImage := -1; LVColData.fmt := Ord( aAlign ); - if aWidth < 0 then + if aWidth < 0 then begin - aWidth := -aWidth; - LVColData.fmt := LVColData.fmt or LVCFMT_BITMAP_ON_RIGHT; + aWidth := -aWidth; + LVColData.fmt := LVColData.fmt or LVCFMT_BITMAP_ON_RIGHT; end; LVColData.cx := aWidth; - if aWidth > 0 then - LVColData.mask := LVColData.mask or LVCF_WIDTH; + if aWidth > 0 then + LVColData.mask := LVColData.mask or LVCF_WIDTH; LVColData.pszText := PKOL_Char( aText ); - if Perform( LVM_INSERTCOLUMN, ColIdx, Integer( @LVColData ) ) >= 0 then - Inc( fLVColCount ); + if Perform( LVM_INSERTCOLUMN, ColIdx, Integer( @LVColData ) ) >= 0 then + Inc( DF.fLVColCount ); end; -//[function TControl.GetLVColText] function TControl.GetLVColText(Idx: Integer): KOLString; var Buf: array[ 0..4095 ] of KOLChar; LC: TLVColumn; @@ -47517,7 +47335,6 @@ begin Result := Buf; end; -//[procedure TControl.SetLVColText] procedure TControl.SetLVColText(Idx: Integer; const Value: KOLString); var LC: TLVColumn; begin @@ -47529,7 +47346,6 @@ begin Perform( LVM_SETCOLUMN, Idx, Integer( @ LC ) ); end; -//[function TControl.GetLVColalign] function TControl.GetLVColalign(Idx: Integer): TTextAlign; const Formats: array[ 0..2 ] of TTextAlign = ( taLeft, taRight, taCenter ); var LC: TLVColumn; @@ -47540,7 +47356,6 @@ begin Result := Formats[ LC.fmt and LVCFMT_JUSTIFYMASK ]; end; -//[procedure TControl.SetLVColalign] procedure TControl.SetLVColalign(Idx: Integer; const Value: TTextAlign); const FormatFlags: array[ TTextAlign ] of BYTE = ( LVCFMT_LEFT, LVCFMT_RIGHT, LVCFMT_CENTER ); @@ -47553,7 +47368,6 @@ begin Perform( LVM_SETCOLUMN, Idx, Integer( @ LC ) ); end; -//[function TControl.GetLVColEx] function TControl.GetLVColEx(Idx: Integer; const Index: Integer): Integer; var LC: TLVColumn; begin @@ -47564,7 +47378,6 @@ begin end; //********************** changed by Mike Gerasimov -//[procedure TControl.SetLVColEx] procedure TControl.SetLVColEx(Idx: Integer; const Index: Integer; const Value: Integer); var LC: TLVColumn; @@ -47583,8 +47396,6 @@ begin Perform( LVM_SETCOLUMN, Idx, Integer( @ LC ) ); end; -//* -//[function TControl.LVAdd] function TControl.LVAdd(const aText: KOLString; ImgIdx: Integer; State: TListViewItemState; StateImgIdx, OverlayImgIdx: Integer; Data: DWORD): Integer; @@ -47592,8 +47403,6 @@ begin Result := LVInsert( MaxInt {Count}, aText, ImgIdx, State, StateImgIdx, OverlayImgIdx, Data ); end; -//* -//[function TControl.LVInsert] function TControl.LVInsert(Idx: Integer; const aText: KOLString; ImgIdx: Integer; State: TListViewItemState; StateImgIdx, OverlayImgIdx: Integer; Data: DWORD): Integer; @@ -47623,11 +47432,8 @@ begin LVI.iImage := ImgIdx; LVI.lParam := Data; Result := Perform( LVM_INSERTITEM, 0, Integer( @LVI ) ); - //Perform( LVM_REDRAWITEMS, Idx, Idx ); end; -//* -//[procedure TControl.LVSetItem] procedure TControl.LVSetItem(Idx, Col: Integer; const aText: KOLString; ImgIdx: Integer; State: TListViewItemState; StateImgIdx, OverlayImgIdx: Integer; Data: DWORD); @@ -47672,25 +47478,22 @@ begin Assert( False, 'Can not set item ' ); end; -//* -//[procedure LVGetItem] procedure LVGetItem( Sender: PControl; Idx, Col: Integer; var LVI: TLVItem; TextBuf: PKOL_Char; TextBufSize: Integer ); begin LVI.mask := LVIF_STATE or LVIF_PARAM or LVIF_IMAGE; - if Col > 0 then - if not (lvoSubItemImages in Sender.fLVOptions) then - LVI.mask := LVIF_STATE or LVIF_PARAM; + if Col > 0 then + if not (lvoSubItemImages in Sender.DF.fLVOptions) then + LVI.mask := LVIF_STATE or LVIF_PARAM; LVI.iItem := Idx; LVI.iSubItem := Col; LVI.pszText := TextBuf; LVI.cchTextMax := TextBufSize; - if TextBufSize <> 0 then - LVI.mask := LVI.mask or LVIF_TEXT; + if TextBufSize <> 0 then + LVI.mask := LVI.mask or LVIF_TEXT; Sender.Perform( LVM_GETITEM, 0, Integer( @LVI ) ); end; -//[function TControl.LVGetItemImgIdx] function TControl.LVGetItemImgIdx(Idx: Integer): Integer; var LVI: TLVItem; begin @@ -47699,7 +47502,6 @@ begin Result := LVI.iImage; end; -//[procedure TControl.LVSetItemImgIdx] procedure TControl.LVSetItemImgIdx(Idx: Integer; const Value: Integer); var LVI: TLVItem; begin @@ -47708,7 +47510,6 @@ begin Perform( LVM_SETITEM, 0, Integer( @LVI ) ); end; -//[function TControl.LVGetItemText] function TControl.LVGetItemText(Idx, Col: Integer): KOLString; var LVI: TLVItem; TextBuf: PKOL_Char; @@ -47729,8 +47530,6 @@ begin FreeMem( TextBuf ); end; -//* -//[procedure TControl.LVSetItemText] procedure TControl.LVSetItemText(Idx, Col: Integer; const Value: KOLString); var LVI: TLVItem; begin @@ -47739,34 +47538,29 @@ begin Perform( LVM_SETITEMTEXT, Idx, Integer( @LVI ) ); end; -//[procedure TControl.LVColDelete] procedure TControl.LVColDelete(ColIdx: Integer); begin Perform( LVM_DELETECOLUMN, ColIdx, 0 ); - if fLVColCount > 0 then - Dec( fLVColCount ); + if DF.fLVColCount > 0 then + Dec( DF.fLVColCount ); end; -//[procedure TControl.SetLVOptions] procedure TControl.SetLVOptions(const Value: TListViewOptions); begin - if fLVOptions = Value then Exit; - fLVOptions := Value; + if DF.fLVOptions = Value then Exit; + DF.fLVOptions := Value; ApplyImageLists2ListView( @Self ); PostMessage( fHandle, WM_SIZE, 0, 0 ); // to restore scrollers (otherwise its are lost) end; -//[procedure TControl.SetLVStyle] procedure TControl.SetLVStyle(const Value: TListViewStyle); begin - if fLVStyle = Value then Exit; - fLVStyle := Value; + if DF.fLVStyle = Value then Exit; + DF.fLVStyle := Value; ApplyImageLists2ListView( @Self ); end; -//[function TControl.Perform] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.Perform(msgcode: DWORD; wParam, lParam: Integer): Integer; stdcall; begin {$IFDEF INPACKAGE} @@ -47783,9 +47577,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.Postmsg] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.Postmsg(msgcode: DWORD; wParam, lParam: Integer): Boolean; stdcall; begin Result := PostMessage( GetWindowHandle, msgcode, wParam, lParam ); @@ -47793,9 +47585,7 @@ end; {$ENDIF ASM_VERSION} {$ENDIF WIN_GDI} -//[function TControl.GetChildCount] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.GetChildCount: Integer; begin Result := fChildren.fCount; @@ -47803,33 +47593,25 @@ end; {$ENDIF ASM_VERSION} {$IFDEF WIN_GDI} -//[procedure TControl.LVDelete] procedure TControl.LVDelete(Idx: Integer); begin Perform( LVM_DELETEITEM, Idx, 0 ); end; -//[procedure TControl.LVEditItemLabel] procedure TControl.LVEditItemLabel(Idx: Integer); begin Perform( LVM_EDITLABEL, Idx, 0 ); end; -//* -//[function TControl.LVItemRect] function TControl.LVItemRect(Idx: Integer; Part: TGetLVItemPart): TRect; const Parts: array[ TGetLVItemPart ] of Byte = ( LVIR_BOUNDS, LVIR_ICON, LVIR_LABEL, LVIR_SELECTBOUNDS ); begin Result := MakeRect( Parts[ Part ], 0, 0, 0 ); - if Perform( LVM_GETITEMRECT, Idx, Integer( @Result ) ) = 0 then - begin - //ShowMessage( SysErrorMessage( GetLastError ) ); - Result := MakeRect( 0, 0, 0, 0 ); - end; + if Perform( LVM_GETITEMRECT, Idx, Integer( @Result ) ) = 0 then + Result := MakeRect( 0, 0, 0, 0 ); end; -//[function TControl.LVSubItemRect] function TControl.LVSubItemRect(Idx, ColIdx: Integer): TRect; var Hdr: HWnd; R, R1: TRect; @@ -47865,30 +47647,22 @@ begin end; end; -//* -//[function TControl.LVGetItemPos] function TControl.LVGetItemPos(Idx: Integer): TPoint; begin Perform( LVM_GETITEMPOSITION, Idx, Integer( @Result ) ); end; -//* -//[procedure TControl.LVSetItemPos] procedure TControl.LVSetItemPos(Idx: Integer; const Value: TPoint); begin Perform( LVM_SETITEMPOSITION32, Idx, Integer( @Value ) ); end; -//* -//[function TControl.LVItemAtPos] function TControl.LVItemAtPos(X, Y: Integer): Integer; var Dummy: TWherePosLVItem; begin Result := LVItemAtPosEx( X, Y, Dummy ); end; -//* -//[function TControl.LVItemAtPosEx] function TControl.LVItemAtPosEx(X, Y: Integer; var Where: TWherePosLVItem): Integer; var HTI: TLVHitTestInfo; @@ -47911,15 +47685,12 @@ begin Where := lvwpOnItem; end; -//[procedure TControl.LVMakeVisible] procedure TControl.LVMakeVisible(Item: Integer; PartiallyOK: Boolean); begin if Item < 0 then Exit; Perform( LVM_ENSUREVISIBLE, Item, Integer( PartiallyOK ) ); end; -//* -//[procedure TControl.LVSetColorByIdx] procedure TControl.LVSetColorByIdx(const Index: Integer; const Value: TColor); var MsgCode: Integer; @@ -47928,7 +47699,7 @@ begin MsgCode := Index + 1; case MsgCode of LVM_SETTEXTCOLOR: fTextColor := Value; - LVM_SETTEXTBKCOLOR: fLVTextBkColor := Value; + LVM_SETTEXTBKCOLOR: DF.fLVTextBkColor := Value; LVM_SETBKCOLOR: fColor := Value; end; ColorValue := Color2RGB( Value ); @@ -47936,7 +47707,6 @@ begin end; {$IFDEF F_P} -//[function TControl.LVGetColorByIdx] function TControl.LVGetColorByIdx(const Index: Integer): TColor; begin CASE Index OF @@ -47947,30 +47717,22 @@ begin end; {$ENDIF F_P} -//* -//[function TControl.GetIntVal] function TControl.GetIntVal(const Index: Integer): Integer; begin Result := GetItemVal( 0, Index ); end; -//* -//[procedure TControl.SetIntVal] procedure TControl.SetIntVal(const Index, Value: Integer); begin SetItemVal( Value, Index, 0 ); end; -//* -//[function TControl.GetItemVal] function TControl.GetItemVal(Item: Integer; const Index: Integer): Integer; begin Result := Perform( LoWord(Index), Item, 0 ); end; -//[procedure TControl.SetItemVal] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.SetItemVal(Item: Integer; const Index: Integer; const Value: Integer); var MsgCode: Integer; begin @@ -47983,7 +47745,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.GetSBMinMax] function TControl.GetSBMinMax: TPoint; {$IFDEF _D2} var X, Y: Integer; @@ -48000,10 +47761,9 @@ begin Dec(Result.Y, SBPageSize - 1); end else - Result := fSBMinMax; + Result := DF.fSBMinMax; end; -//[procedure TControl.GetSBPageSize] function TControl.GetSBPageSize: Integer; var SI: TScrollInfo; @@ -48015,44 +47775,42 @@ begin Result := SI.nPage; end; -//[procedure TControl.GetSBPosition] function TControl.GetSBPosition: Integer; begin Result := GetScrollPos(Handle, SB_CTL); end; -//[procedure TControl.SetSBMax] procedure TControl.SetSBMax(Value: Longint); var P: TPoint; begin - fSBMinMax.Y := Value; - if (Handle <> 0) then begin - P := SBMinMax; - P.Y := Value; - SBMinMax := P; + DF.fSBMinMax.Y := Value; + if (Handle <> 0) then + begin + P := SBMinMax; + P.Y := Value; + SBMinMax := P; end; end; -//[procedure TControl.SetSBMin] procedure TControl.SetSBMin(Value: Longint); var P: TPoint; begin - fSBMinMax.X := Value; - if (Handle <> 0) then begin - P := SBMinMax; - P.X := Value; - SBMinMax := P; + DF.fSBMinMax.X := Value; + if (Handle <> 0) then + begin + P := SBMinMax; + P.X := Value; + SBMinMax := P; end; end; -//[procedure TControl.SetSBPageSize] procedure TControl.SetSBPageSize(Value: Integer); var SI: TScrollInfo; begin - fSBPageSize := Value; + DF.fSBPageSize := Value; if (Handle <> 0) then begin FillChar(SI, SizeOf(SI), #0); SI.cbSize := SizeOf(SI); @@ -48070,32 +47828,28 @@ begin end; end; -//[procedure TControl.SetSBPosition] procedure TControl.SetSBPosition(Value: Integer); begin - fSBPosition := Value; - if (Handle <> 0) then - SetScrollPos(Handle, SB_CTL, Value, True); + DF.fSBPosition := Value; + if (Handle <> 0) then + SetScrollPos(Handle, SB_CTL, Value, True); end; -//[procedure TControl.SetSBMinMax] procedure TControl.SetSBMinMax(const Value: TPoint); begin GetSBMinMax; - if (Handle <> 0) then - SetScrollRange(Handle, SB_CTL, Value.X, - Value.Y {$IFDEF SCROLL_OLD} + SBPageSize - 1{$ENDIF (by QAZ)} , True) + if (Handle <> 0) then + SetScrollRange(Handle, SB_CTL, Value.X, + Value.Y {$IFDEF SCROLL_OLD} + SBPageSize - 1{$ENDIF (by QAZ)} , True) else - fSBMinMax := Value; + DF.fSBMinMax := Value; end; -//[procedure TControl.SBSetScrollInfo] function TControl.SBSetScrollInfo(const SI: TScrollInfo): Integer; begin Result := SetScrollInfo(Handle, SB_CTL, SI, True) end; -//[procedure TControl.SBGetScrollInfo] function TControl.SBGetScrollInfo(var SI: TScrollInfo): Boolean; begin Result := Cardinal(GetScrollInfo(Handle, SB_CTL, SI)) <> 0; @@ -48103,14 +47857,13 @@ end; { -- OpenSaveDialog -- } -//* -//[function NewOpenSaveDialog] function NewOpenSaveDialog( const Title, StrtDir: KOLString; Options: TOpenSaveOptions ): POpenSaveDialog; begin - {-} New( Result, Create ); - {+}{++}(*Result := POpenSaveDialog.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TOpenSaveDialog'; + {$ENDIF} Result.FOptions := Options; if Options = [] then Result.FOptions := DefOpenSaveDlgOptions; @@ -48118,13 +47871,10 @@ begin Result.FTitle := Title; Result.FInitialDir := StrtDir; end; -//[END NewOpenSaveDialog] { TOpenSaveDialog } -//[destructor TOpenSaveDialog.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TOpenSaveDialog.Destroy; begin FFilter := ''; @@ -48139,7 +47889,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TOpenSaveDialog.Execute] {$IFDEF ASM_UNICODE} function TOpenSaveDialog.Execute: Boolean; asm @@ -48338,19 +48087,19 @@ var Fltr : KOLString; TempFilename : KOLString; - Function MakeFilter(s : Ansistring) : AnsiString; + Function MakeFilter(s : KOLString) : KOLString; { format of filter for API call is following: 'text files'#0'*.txt'#0 'bitmap files'#0'*.bmp'#0#0 } - var Str: PAnsiChar; + var Str: PKOLChar; begin Result := s; if Result='' then exit; Result:=Result+#0; {Delphi string always end on #0 is this is #0#0} - Str := PAnsiChar( Result ); + Str := PKOLChar( Result ); while Str^ <> #0 do begin if Str^ = '|' then @@ -48377,12 +48126,12 @@ begin if fWnd <> 0 then ofn.hWndOwner := fWnd else - if assigned(applet) then - ofn.hwndOwner:=applet.Handle; + if Applet <> nil then + ofn.hwndOwner := applet.Handle; ofn.hInstance:=HInstance; - Fltr:=MakeFilter(FFilter); + Fltr := MakeFilter(FFilter); if Fltr <> '' then ofn.lpstrFilter := PKOLchar(Fltr); ofn.nFilterIndex := FFilterIndex; @@ -48439,26 +48188,22 @@ end; { -- OpenDirDialog -- } -//* -//[function NewOpenDirDialog] function NewOpenDirDialog( const Title: KOLString; Options: TOpenDirOptions ): POpenDirDialog; begin - {-} New( Result, Create ); - {+}{++}(*Result := POpenDirDialog.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TOpenDirDialog'; + {$ENDIF} Result.FOptions := [ odOnlySystemDirs ]; if Options <> [] then Result.FOptions := Options; Result.FTitle := Title; end; -//[END NewOpenDirDialog] { TOpenDirDialog } -//[destructor TOpenDirDialog.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TOpenDirDialog.Destroy; begin FTitle := ''; @@ -48503,7 +48248,6 @@ type end; TBrowseInfo = {$IFDEF UNICODE_CTRLS} TBrowseInfoW {$ELSE} TBrowseInfoA {$ENDIF}; -//[API SHXXXXXXXXXX] function SHBrowseForFolderA(var lpbi: TBrowseInfoA): PItemIDList; stdcall; external 'shell32.dll' name 'SHBrowseForFolderA'; {$IFDEF UNICODE_CTRLS} @@ -48541,7 +48285,6 @@ const BFFM_SETSELECTIONW = WM_USER + 103; {$IFDEF ASM_UNICODE} // WndOwner -//[function TOpenDirDialog.Execute] function TOpenDirDialog.Execute: Boolean; asm PUSH EBX @@ -48608,10 +48351,10 @@ begin if WndOwner <> 0 then BI.hwndOwner := WndOwner else - if assigned( Applet ) then - BI.hwndOwner := Applet.Handle + if Applet <> nil then + BI.hwndOwner := Applet.Handle else - BI.hwndOwner := 0; + BI.hwndOwner := 0; BI.pidlRoot := nil; BI.pszDisplayName := @FBuf[ 0 ]; BI.lpszTitle := PKOLChar( Title ); @@ -48629,19 +48372,16 @@ begin end; {$ENDIF ASM_VERSION} -//[function TOpenDirDialog.GetInitialPath] function TOpenDirDialog.GetInitialPath: KOLString; begin Result := IncludeTrailingPathDelimiter( fInitialPath ); end; -//[function TOpenDirDialog.GetPath] function TOpenDirDialog.GetPath: KOLString; begin Result := FBuf; end; -//[FUNCTION OpenDirSelChangeCallBack] {$IFDEF ASM_UNICODE} function OpenDirSelChangeCallBack( Wnd: HWnd; Msg: DWORD; lParam, lpData: LParam ): Integer; stdcall; @@ -48687,7 +48427,7 @@ var _Self_: POpenDirDialog; EnableOK: Integer; begin _Self_ := Pointer( lpData ); - if assigned( _Self_.FOnSelChanged ) then + if Assigned( _Self_.FOnSelChanged ) then begin {$IFDEF UNICODE_CTRLS} SHGetPathFromIDListW {$ELSE} SHGetPathFromIDListA {$ENDIF}( PItemIDList( lParam ), @ _Self_.FBuf[ 0 ] ); EnableOK := 0; @@ -48700,14 +48440,12 @@ begin Result := 0; end; {$ENDIF ASM_VERSION} -//[END OpenDirSelChangeCallBack] {$IFDEF ASM_LOCAL} {$UNDEF ASM_LOCAL} {$ENDIF} {$IFNDEF NEW_OPEN_DIR_STYLE_EX} {$IFDEF ASM_VERSION} {$DEFINE ASM_LOCAL} {$ENDIF} {$ENDIF} -//[FUNCTION OpenDirCallBack] {$IFDEF ASM_LOCAL} {$ELSE ASM_VERSION} //Pascal function OpenDirCallBack( Wnd: HWnd; Msg: DWORD; lParam, lpData: LParam ): Integer; @@ -48724,7 +48462,7 @@ begin Self_.FDialogWnd := Wnd; if Msg = BFFM_INITIALIZED then begin - if assigned( Self_.FCenterProc ) then + if Assigned( Self_.FCenterProc ) then Self_.FCenterProc( Wnd ); if Self_.FInitialPath <> '' then begin @@ -48757,7 +48495,7 @@ begin else if Msg = BFFM_SELCHANGED then begin - if assigned( Self_.FDoSelChanged ) then + if Assigned( Self_.FDoSelChanged ) then Self_.FDoSelChanged( Wnd, Msg, lParam, lpData ) else SendMessage( Wnd, BFFM_ENABLEOK, 0, 1 ); @@ -48765,11 +48503,8 @@ begin Result := 0; end; {$ENDIF ASM_VERSION} -//[END OpenDirCallBack] -//[PROCEDURE OpenDirDlgCenter] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure OpenDirDlgCenter( Wnd: HWnd ); var R: TRect; W, H: Integer; @@ -48782,11 +48517,8 @@ begin MoveWindow( Wnd, R.Left, R.Top, W, H, True ); end; {$ENDIF ASM_VERSION} -//[END OpenDirDlgCenter] -//[procedure TOpenDirDialog.SetCenterOnScreen] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TOpenDirDialog.SetCenterOnScreen(const Value: Boolean); var P: procedure( Wnd: HWnd ); begin @@ -48798,7 +48530,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TOpenDirDialog.SetInitialPath] procedure TOpenDirDialog.SetInitialPath(const Value: KOLString); begin FCallBack := @OpenDirCallBack; @@ -48808,7 +48539,6 @@ begin FInitialPath := IncludeTrailingPathDelimiter( Value ); end; -//[procedure TOpenDirDialog.SetOnSelChanged] procedure TOpenDirDialog.SetOnSelChanged(const Value: TOnODSelChange); begin FOnSelChanged := Value; @@ -48820,12 +48550,10 @@ type PByteArray =^TByteArray; TByteArray = array[Word]of Byte; -//[API CreateMappedBitmap] function CreateMappedBitmap(Instance: THandle; Bitmap: Integer; Flags: UINT; ColorMap: PColorMap; NumMaps: Integer): HBitmap; stdcall; external cctrl name 'CreateMappedBitmap'; -//[function CreateMappedBitmapEx] function CreateMappedBitmapEx(Instance: THandle; BmpRsrcName: PKOLChar; Flags: Cardinal; ColorMap: PColorMap; NumMaps: Integer): HBitmap; var bi: TBITMAPINFO; @@ -48887,8 +48615,6 @@ begin FreeMem( Bits ); end; -//* -//[function LoadMappedBitmap] function LoadMappedBitmap( hInst: THandle; BmpResID: Integer; const Map: array of TColor ) : HBitmap; var Map2Pass: Pointer; @@ -48899,7 +48625,6 @@ begin Result := CreateMappedBitmap( hInst, BmpResID, 0, Map2Pass, (High( Map ) + 1) div 2 ); end; -//[function LoadMappedBitmapEx] function LoadMappedBitmapEx( MasterObj: PObj; hInst: THandle; BmpResName: PKOLChar; const Map: array of TColor ) : HBitmap; var Map2Pass: Pointer; @@ -48915,7 +48640,6 @@ end; { -- Toolbar -- } {$IFDEF ASM_noVERSION} // width -//[procedure TControl.TBAddBitmap] procedure TControl.TBAddBitmap(Bitmap: HBitmap); const szBI = sizeof(TBitmapInfo); asm @@ -49004,7 +48728,7 @@ begin begin AB.hInst := 0; AB.nID := Bitmap; - W := fTBBtnImgWidth; + W := DF.fTBBtnImgWidth; if W = 0 then W := Abs( BI.bmiHeader.biHeight ); N := BI.bmiHeader.biWidth div W; @@ -49016,7 +48740,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.TBAddInsButtons] {$IFDEF ASM_UNICODE} function TControl.TBAddInsButtons(Idx: Integer; const Buttons: array of PKOLChar; const BtnImgIdxArray: array of Integer): Integer; stdcall; @@ -49090,7 +48813,7 @@ asm JMP @@3 {$IFDEF _D2009orHigher} - DW 0, 1 + DW 0, 1 {$ENDIF} DD -1, 1 @@0: DB 0 @@ -49124,11 +48847,14 @@ asm MOV EBX, EAX @@210: {$ENDIF} + MOV ECX, [EBP+8] + MOV AH, BYTE PTR [ECX].TControl.DF.fDefaultTBBtnStyle + POP ECX - MOV AX, $1004 // AL=fsState=_ENABLED, AH=fsStyle=_AUTOSIZE + MOV AL, 4 // AL=fsState=_ENABLED, AH=fsStyle=_AUTOSIZE if fDefaultTBBtnStyle contains CMP byte ptr [ECX], '^' JNE @@22 - MOV AH, TBSTYLE_DROPDOWN or TBSTYLE_AUTOSIZE + OR AH, TBSTYLE_DROPDOWN INC ECX @@22: CMP byte ptr [ECX], '-' JZ @@23 @@ -49163,7 +48889,7 @@ asm MOV EAX, ESP {$IFDEF _D2009orHigher} PUSH ECX - XOR ECX, ECX + XOR ECX, ECX {$ENDIF} CALL System.@LStrFromPChar {$IFDEF _D2009orHigher} @@ -49258,10 +48984,10 @@ function TControl.TBAddInsButtons(Idx: Integer; const Buttons: array of PKOLChar if High( BtnImgIdxArray ) >= N then PAB.iBitmap := BtnImgIdxArray[ N ]; PAB.fsState := TBSTATE_ENABLED; - PAB.fsStyle := TBSTYLE_BUTTON or TBSTYLE_AUTOSIZE; + PAB.fsStyle := TBSTYLE_BUTTON or DF.fDefaultTBBtnStyle; if Str^ = '^' then begin - PAB.fsStyle := TBSTYLE_DROPDOWN or TBSTYLE_AUTOSIZE; + PAB.fsStyle := TBSTYLE_DROPDOWN or DF.fDefaultTBBtnStyle; Inc( Str ); end; if CharIn( Str^, [ '-', '+' ] ) then @@ -49320,9 +49046,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.TBAddButtons] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.TBAddButtons(const Buttons: array of PKOLChar; const BtnImgIdxArray: array of Integer): Integer; begin @@ -49330,10 +49054,8 @@ begin end; {$ENDIF ASM_VERSION} -//* -//[function TControl.TBInsertButtons] function TControl.TBInsertButtons(BeforeIdx: Integer; - Buttons: array of PKOLChar; BtnImgIdxArray: array of Integer): Integer; + Buttons: array of PKOLChar; const BtnImgIdxArray: array of Integer): Integer; var I, J, K: Integer; begin J := -1; @@ -49349,7 +49071,6 @@ begin end; end; -//[function GetTBBtnGoodID] function GetTBBtnGoodID( Toolbar: PControl; BtnIDorIdx: Integer ): Integer; // change by Alexander Pravdin (to fix toolbar with separator first): //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -49375,17 +49096,11 @@ type end; PTBButtonEvent = ^TTBButtonEvent; -//[procedure TControl.TBFreeTBevents] procedure TControl.TBFreeTBevents; begin - //if fTBevents <> nil then - begin - fTBevents.Release; - //fTBevents := nil; - end; + DF.fTBevents.Release; end; -//[function WndProcToolbarButtonsClicks] function WndProcToolbarButtonsClicks( TB: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Notify: PTBNotify; I: Integer; @@ -49397,9 +49112,9 @@ begin Notify := Pointer( Msg.lParam ); if Notify.hdr.code = NM_CLICK then begin - for I := TB.fTBevents.fCount-1 downto 0 do + for I := TB.DF.fTBevents.fCount-1 downto 0 do begin - Event := TB.fTBevents.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ]; + Event := TB.DF.fTBevents.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ]; if Integer( Event.BtnID ) = Notify.iItem then begin if Assigned( Event.Event ) then @@ -49418,30 +49133,28 @@ begin end; end; -//[procedure TControl.TBAssignEvents] procedure TControl.TBAssignEvents(BtnID: Integer; Events: array of TOnToolbarButtonClick); var I: Integer; EventRec: PTBButtonEvent; begin - if fTBevents = nil then + if DF.fTBevents = nil then begin - fTBevents := NewList; - Add2AutoFreeEx( TBFreeTBevents ); - AttachProc( WndProcToolbarButtonsClicks ); + DF.fTBevents := NewList; + Add2AutoFreeEx( TBFreeTBevents ); + AttachProc( WndProcToolbarButtonsClicks ); end; BtnID := GetTBBtnGoodID( @Self, BtnID ); for I := 0 to High( Events ) do begin - GetMem( EventRec, Sizeof( TTBButtonEvent ) ); - fTBevents.Add( EventRec ); - EventRec.Event := Events[ I ]; - EventRec.BtnID := BtnID; - Inc( BtnID ); + GetMem( EventRec, Sizeof( TTBButtonEvent ) ); + DF.fTBevents.Add( EventRec ); + EventRec.Event := Events[ I ]; + EventRec.BtnID := BtnID; + Inc( BtnID ); end; end; -//[procedure TControl.TBResetImgIdx] procedure TControl.TBResetImgIdx( BtnID, BtnCount: Integer ); begin while BtnCount > 0 do @@ -49452,22 +49165,16 @@ begin end; end; -//* -//[function TControl.TBGetButtonVisible] function TControl.TBGetButtonVisible(BtnID: Integer): Boolean; begin Result := Perform( TB_ISBUTTONHIDDEN, GetTBBtnGoodID( @ Self, BtnID ), 0 ) = 0; end; -//* -//[function TControl.TBItem2Index] function TControl.TBItem2Index(BtnID: Integer): Integer; begin Result := Perform( TB_COMMANDTOINDEX, BtnID, 0 ); end; -//* -//[procedure TControl.TBSetButtonVisible] procedure TControl.TBSetButtonVisible(BtnID: Integer; const Value: Boolean); begin @@ -49475,9 +49182,7 @@ begin Perform( TB_HIDEBUTTON, BtnID, Integer( not Value ) ); end; -//[function TControl.TBGetBtnStt] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.TBGetBtnStt(BtnID: Integer; const Index: Integer): Boolean; begin BtnID := GetTBBtnGoodID( @Self, BtnID ); @@ -49485,17 +49190,13 @@ begin end; {$ENDIF ASM_VERSION} -//+ -//[procedure TControl.TBSetBtnStt] procedure TControl.TBSetBtnStt(BtnID: Integer; const Index: Integer; const Value: Boolean); begin BtnID := GetTBBtnGoodID( @Self, BtnID ); Perform( Index, BtnID, Integer( Value ) ); end; -//[function TControl.TBIndex2Item] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.TBIndex2Item(Idx: Integer): Integer; var ButtonInfo: TTBButton; begin @@ -49505,7 +49206,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.TBConvertIdxArray2ID] procedure TControl.TBConvertIdxArray2ID(const IdxVars: array of PDWORD); var i: Integer; begin @@ -49513,7 +49213,6 @@ begin IdxVars[ i ]^ := TBIndex2Item( IdxVars[ I ]^ ); end; -//[function TControl.TBGetButtonText] {$IFDEF ASM_UNICODE} function TControl.TBGetButtonText( BtnID: Integer ): AnsiString; asm @@ -49552,7 +49251,6 @@ end; {$ENDIF ASM_VERSION} //* -//[function TControl.TBGetButtonRect] function TControl.TBGetButtonRect(BtnID: Integer): TRect; begin BtnID := GetTBBtnGoodID( @Self, BtnID ); @@ -49565,23 +49263,20 @@ begin end; //* -//[function TControl.TBGetRows] function TControl.TBGetRows: Integer; begin - Result := 1; - UpdateWndStyles; - if (TBSTYLE_WRAPABLE and fStyle) <> 0 then - Result := Perform( TB_GETROWS, 0, 0 ); + Result := 1; + UpdateWndStyles; + if (TBSTYLE_WRAPABLE and fStyle.Value) <> 0 then + Result := Perform( TB_GETROWS, 0, 0 ); end; //* -//[procedure TControl.TBSetRows] procedure TControl.TBSetRows(const Value: Integer); begin Perform( TB_SETROWS, Value, 0 ); end; -//[function TControl.TBMoveBtn] function TControl.TBMoveBtn(FromIdx, ToIdx: Integer): Boolean; var btn: TTBButton; begin @@ -49591,32 +49286,30 @@ begin Perform(TB_INSERTBUTTON,ToIdx,integer(@btn)); end; -//[procedure TControl.TBSetTooltips] -{$IFDEF ASM_VERSION} //{$IFDEF ASM_UNICODE} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.TBSetTooltips(BtnID1st: Integer; const Tooltips: array of PKOLChar); var I, J: Integer; begin - if not assigned( fTBttCmd ) then + if ( DF.fTBttCmd = nil ) then begin - fTBttCmd := NewList; - fTBttTxt := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF}; + DF.fTBttCmd := NewList; + DF.fTBttTxt := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF}; {$IFDEF USE_AUTOFREE4CONTROLS} - Add2AutoFree( fTBttCmd ); - Add2AutoFree( fTBttTxt ); + Add2AutoFree( DF.fTBttCmd ); + Add2AutoFree( DF.fTBttTxt ); {$ENDIF} end; for I:= 0 to High( Tooltips ) do begin - J := fTBttCmd.IndexOf( Pointer( BtnID1st ) ); + J := DF.fTBttCmd.IndexOf( Pointer( BtnID1st ) ); if J < 0 then begin - fTBttCmd.Add( Pointer( BtnID1st ) ); - fTBttTxt.Add( Tooltips[ I ] ); + DF.fTBttCmd.Add( Pointer( BtnID1st ) ); + DF.fTBttTxt.Add( Tooltips[ I ] ); end else - fTBttTxt.Items[ J ] := Tooltips[ I ]; + DF.fTBttTxt.Items[ J ] := Tooltips[ I ]; Inc( BtnID1st ); end; end; @@ -49658,9 +49351,15 @@ begin Toolbar.TBButtonChecked[ BtnID ] := Checked; end; -//[function TControl.TBButtonAtPos] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +procedure ToolbarAddButtons( Toolbar: PControl; const Buttons: array of PKOLChar; + const BtnImgIdxArray: array of Integer; Bitmap: HBitmap ); +begin + Toolbar.TBAddButtons( Buttons, BtnImgIdxArray ); + if Bitmap <> 0 then + Toolbar.TBAddBitmap( Bitmap ); +end; + +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.TBButtonAtPos(X, Y: Integer): Integer; var I: Integer; begin @@ -49671,9 +49370,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.TBBtnIdxAtPos] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.TBBtnIdxAtPos(X, Y: Integer): Integer; var I: Integer; R: TRect; @@ -49693,7 +49390,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.TBButtonSeparator] function TControl.TBButtonSeparator(BtnID: Integer): Boolean; var B: TTBButton; begin @@ -49703,7 +49399,6 @@ begin end; //* -//[procedure TControl.TBDeleteButton] procedure TControl.TBDeleteButton(BtnID: Integer); begin BtnID := GetTBBtnGoodID( @Self, BtnID ); @@ -49711,14 +49406,12 @@ begin end; //* -//[procedure TControl.TBDeleteBtnByIdx] procedure TControl.TBDeleteBtnByIdx(Idx: Integer); begin Perform( TB_DELETEBUTTON, Idx, 0 ); end; //* -//[procedure TControl.TBClear] procedure TControl.TBClear; var i: Integer; @@ -49728,14 +49421,12 @@ begin end; //* -//[procedure TControl.Clear] procedure TControl.Clear; begin fCommandActions.aClear( @Self ); end; {$IFDEF ASM_noVERSION} -//[function TControl.TBGetBtnImgIdx] function TControl.TBGetBtnImgIdx(BtnID: Integer): Integer; const szTBButton = sizeof( TTBButton ); asm @@ -49761,15 +49452,12 @@ end; {$ENDIF ASM_VERSION} //* -//[procedure TControl.TBSetBtnImgIdx] procedure TControl.TBSetBtnImgIdx(BtnID: Integer; const Value: Integer); begin Perform( TB_CHANGEBITMAP, GetTBBtnGoodID( @Self, BtnID ), Value ); end; -//[procedure TControl.TBSetButtonText] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.TBSetButtonText(BtnID: Integer; const Value: KOLString); var BI: TTBButtonInfo; begin @@ -49781,9 +49469,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TControl.TBGetBtnWidth] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.TBGetBtnWidth(BtnID: Integer): Integer; var R: TRect; begin @@ -49792,9 +49478,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.TBSetBtnWidth] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.TBSetBtnWidth(BtnID: Integer; const Value: Integer); var BI: TTBButtonInfo; begin @@ -49808,18 +49492,16 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.TBSetBtMinMaxWidth] procedure TControl.TBSetBtMinMaxWidth(const Idx: Integer; const Value: Integer); begin case Idx of - 0: FTBBtMinWidth := Value; - 1: FTBBtMaxWidth := Value; + 0: DF.fTBBtMinWidth := Value; + 1: DF.fTBBtMaxWidth := Value; end; - Perform( TB_SETBUTTONWIDTH, 0, FTBBtMaxWidth or (FTBBtMinWidth shl 16) ); + Perform( TB_SETBUTTONWIDTH, 0, DF.fTBBtMaxWidth or (DF.fTBBtMinWidth shl 16) ); end; {$IFDEF F_P} -//[function TControl.TBGetBtMinMaxWidth] function TControl.TBGetBtMinMaxWidth(const Idx: Integer): Integer; begin CASE Idx OF @@ -49829,7 +49511,6 @@ begin end; {$ENDIF F_P} -//[function TControl.TBGetButtonLParam] function TControl.TBGetButtonLParam(const Idx: Integer): DWORD; var tb: TTBButtonInfo; @@ -49840,7 +49521,6 @@ begin Result := tb.lParam; end; -//[procedure TControl.TBSetButtonLParam] procedure TControl.TBSetButtonLParam(const Idx: Integer; const Value: DWORD); var tb: TTBButtonInfo; @@ -49861,18 +49541,18 @@ begin CD := Pointer( Msg.lParam ); if CD.nmcd.hdr.code = NM_CUSTOMDRAW then begin - if Assigned( Sender.OnTBCustomDraw ) then - Rslt := Sender.OnTBCustomDraw( Sender, CD^ ) + if Assigned( Sender.DF.fOnTBCustomDraw ) then + Rslt := Sender.DF.fOnTBCustomDraw( Sender, CD^ ) else begin - if Assigned( Sender.fBrush ) then - Windows.FillRect( CD.nmcd.hdc, Sender.ClientRect, Sender.fBrush.Handle ) - else - begin - Br := CreateSolidBrush( Color2RGB( Sender.Color ) ); - Windows.FillRect( CD.nmcd.hdc, Sender.ClientRect, Br ); - DeleteObject( Br ); - end; + if Sender.fBrush <> nil then + Windows.FillRect( CD.nmcd.hdc, Sender.ClientRect, Sender.fBrush.Handle ) + else + begin + Br := CreateSolidBrush( Color2RGB( Sender.Color ) ); + Windows.FillRect( CD.nmcd.hdc, Sender.ClientRect, Br ); + DeleteObject( Br ); + end; Rslt := CDRF_SKIPDEFAULT; end; end; @@ -49881,21 +49561,17 @@ end; procedure TControl.SetOnTBCustomDraw( const Value: TOnTBCustomDraw ); begin - fOnTBCustomDraw := Value; + DF.fOnTBCustomDraw := Value; AttachProc( WndProcTBCustomDraw ); end; -//[procedure TControl.SetDroppedDown] procedure TControl.SetDroppedDown(const Value: Boolean); begin - //fDropped := Value; Perform( CB_SHOWDROPDOWN, Integer( Value ), 0 ); end; -//[procedure TControl.AddDirList] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.AddDirList(const Filemask: KOLString; Attrs: DWORD); begin if fCommandActions.aDir <> 0 then @@ -49903,7 +49579,6 @@ begin end; {$ENDIF ASM_VERSION} -//[FUNCTION WndProcShowModal] {$IFDEF ASM_noVERSION} {$ELSE ASM_VERSION} //Pascal function WndProcShowModal( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; @@ -49912,17 +49587,15 @@ begin Result := FALSE; if Msg.message = WM_CLOSE then begin - if Self_.ModalResult = 0 then { (Sergey Shishmintzev) } - Self_.ModalResult := -1; + if Self_.DF.fModalResult = 0 then { (Sergey Shishmintzev) } + Self_.DF.fModalResult := -1; Rslt := 0; Result := True; // Do not process ! end ; end; {$ENDIF ASM_VERSION} -//[END WndProcShowModal] -//[function WndProcFixModal] // by TR"]F function WndProcFixModal( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; @@ -49938,44 +49611,42 @@ var i: Integer; C: PControl; {$ENDIF MODAL_ACTIVATE_FIX} begin -Result := false; + Result := false; if (Msg.message = WM_SETCURSOR) then if (LoWord(Msg.lParam) = HTERROR) then if (HiWord(Msg.lParam) >= LBtnDown) and (HiWord(Msg.lParam) <= RBtnUp) then begin - if Applet.fModalForm <> nil then - SetForegroundWindow(Applet.fModalForm.Handle); + if Applet.DF.fModalForm <> nil then + SetForegroundWindow(Applet.DF.fModalForm.Handle); Rslt := 1; Result := TRUE; end; {$IFDEF MODAL_ACTIVATE_FIX} - if (Msg.message = WM_ACTIVATEAPP) then - begin - if not Applet.fActivating then - begin - Applet.fActivating := TRUE; - if Msg.wParam <> 0 then + if (Msg.message = WM_ACTIVATEAPP) then + begin + if not Applet.DF.fActivating then begin - for i := Applet.ChildCount-1 downto 0 do - begin - C := Applet.Children[ i ]; - if C.Visible and not C.Enabled then - SetForegroundWindow( C.Handle ); - end; - if Assigned( Applet.fModalForm ) then - SetForegroundWindow( Applet.fModalForm.Handle ); + Applet.DF.fActivating := TRUE; + if Msg.wParam <> 0 then + begin + for i := Applet.ChildCount-1 downto 0 do + begin + C := Applet.Children[ i ]; + if C.Visible and not C.Enabled then + SetForegroundWindow( C.Handle ); + end; + if Applet.DF.fModalForm <> nil then + SetForegroundWindow( Applet.DF.fModalForm.Handle ); + end; + Applet.DF.fActivating := FALSE; end; - Applet.fActivating := FALSE; - end; - end; - {$ENDIF MODAL_ACTIVATE_FIX} + end; + {$ENDIF MODAL_ACTIVATE_FIX} end; -//[END WndProcFixModal] {$IFDEF ASM_noVERSION} // ASM_TLIST! -//[function TControl.ShowModal] function TControl.ShowModal: Integer; asm MOV ECX, [EAX].fParent @@ -49995,7 +49666,11 @@ asm XOR EBP, EBP // CurCtl = nil MOV EAX, [EDI].fCurrentControl + {$IFDEF USE_FLAGS} + TEST [EDI].TControl.fFlagsG3, (1 shl G3_IsApplet) + {$ELSE} CMP [EDI].TControl.FIsApplet, 0 + {$ENDIF} {$IFDEF USE_CMOV} CMOVZ EAX, EDI {$ELSE} @@ -50021,7 +49696,11 @@ asm INC ECX MOV ESI, EDI + {$IFDEF USE_FLAGS} + TEST [EDI].TControl.fFlagsG3, (1 shl G3_IsApplet) + {$ELSE} CMP [EDI].TControl.FIsApplet, 0 + {$ENDIF} JZ @@isapplet MOV EBP, [EDI].fCurrentControl // CurCtl = Applet.fCurrentControl @@ -50129,13 +49808,15 @@ var CurForm: PControl; CurCtl: PControl; // { Alexander Pravdin } begin Result := 0; - if (fIsControl) or (fParent = nil) then + if {$IFDEF USE_FLAGS} (G3_IsControl in fFlagsG3) + {$ELSE} (fIsControl) {$ENDIF} + or (fParent = nil) then begin Show; Exit; end; AttachProc( WndProcShowModal ); - CurForm := Applet.fCurrentControl; + CurForm := Applet.DF.fCurrentControl; FL := NewList; CurCtl := nil; // { Alexander Pravdin } @@ -50143,36 +49824,36 @@ begin begin for I := 0 to Applet.ChildCount - 1 do begin - F := Applet.fChildren.Items[ I ]; - if F <> @Self then - if F.Enabled then - begin - FL.Add( F ); - F.Enabled := FALSE; - {$IFNDEF NOT_FIX_MODAL} - Inc( F.fFixingModal ); - F.AttachProc(WndProcFixModal); {**************} - {$ENDIF} - end; + F := Applet.fChildren.Items[ I ]; + if F <> @Self then + if F.Enabled then + begin + FL.Add( F ); + F.Enabled := FALSE; + {$IFNDEF NOT_FIX_MODAL} + Inc( F.DF.fFixingModal ); + F.AttachProc(WndProcFixModal); {**************} + {$ENDIF} + end; end end else begin CurForm := Applet; - if Applet.Enabled then + if Applet.Enabled then begin - FL.Add( Applet ); - CurCtl := Applet.fCurrentControl; { Alexander Pravdin } - Applet.Enabled := FALSE; - {$IFNDEF NOT_FIX_MODAL} - Inc( Applet.fFixingModal ); - Applet.AttachProc(WndProcFixModal); {**************} - {$ENDIF} + FL.Add( Applet ); + CurCtl := Applet.DF.fCurrentControl; { Alexander Pravdin } + Applet.Enabled := FALSE; + {$IFNDEF NOT_FIX_MODAL} + Inc( Applet.DF.fFixingModal ); + Applet.AttachProc(WndProcFixModal); {**************} + {$ENDIF} end; end; - Inc( fModal ); - Applet.fModalForm := @ Self; + Inc( DF.fModal ); + Applet.DF.fModalForm := @ Self; Enabled := TRUE; Show; @@ -50186,17 +49867,17 @@ begin {$ENDIF} end; - Dec( fModal ); - Applet.fModalForm := nil; + Dec( DF.fModal ); + Applet.DF.fModalForm := nil; DetachProc( WndProcShowModal ); for I := 0 to FL.Count - 1 do begin F := FL.Items[ I ]; {$IFNDEF NOT_FIX_MODAL} - Dec( F.fFixingModal ); - if F.fFixingModal <= 0 then - F.DetachProc(WndProcFixModal); {**************} + Dec( F.DF.fFixingModal ); + if F.DF.fFixingModal <= 0 then + F.DetachProc(WndProcFixModal); {**************} {$ENDIF} F.Enabled := TRUE; end; @@ -50211,7 +49892,6 @@ end; {$ENDIF USE_SHOWMODALPARENTED_ALWAYS} {$ENDIF ASM_VERSION} -//[function TControl.ShowModalParented] {$IFNDEF NEW_MODAL} function TControl.ShowModalParented( const AParent: PControl ): Integer; begin @@ -50227,17 +49907,27 @@ begin Result := 0; if ( AParent = nil ) then Exit; - Inc( fModal ); + Inc( DF.fModal ); FL := NewList; - OldMF := AParent.fModalForm; - AParent.fModalForm := @Self; + OldMF := AParent.DF.fModalForm; + AParent.DF.fModalForm := @Self; - if AParent.fIsApplet or ( AParent.IsMainWindow and AParent.fIsForm ) then + if {$IFDEF USE_FLAGS} (G3_IsApplet in AParent.fFlagsG3) + {$ELSE} AParent.fIsApplet {$ENDIF} + or ( AParent.IsMainWindow and + {$IFDEF USE_FLAGS} (G3_IsForm in AParent.fFlagsG3) + {$ELSE} AParent.fIsForm {$ENDIF} ) then begin for I := 0 to AParent.ChildCount - 1 do begin F := AParent.fChildren.Items[ I ]; - if ( F <> @Self ) and F.fIsForm and F.fEnabled and F.fVisible then + if ( F <> @Self ) + and {$IFDEF USE_FLAGS} (G3_IsForm in F.fFlagsG3) + {$ELSE} F.fIsForm {$ENDIF} + and {$IFDEF USE_FLAGS} + not(F3_Disabled in F.fStyle.f3_Style) and + (F3_Visible in F.fStyle.f3_Style) + {$ELSE} F.fEnabled and F.fVisible {$ENDIF} then begin FL.Add( F ); F.Enabled := FALSE; @@ -50248,10 +49938,13 @@ begin end; end; - if AParent.fIsForm and AParent.Enabled then + if {$IFDEF USE_FLAGS} (G3_IsForm in AParent.fFlagsG3) + {$ELSE} AParent.fIsForm {$ENDIF} + and {$IFDEF USE_FLAGS} not(F3_Disabled in AParent.fStyle.f3_Style) + {$ELSE} AParent.Enabled {$ENDIF} then begin - FL.Add( AParent ); - AParent.Enabled := FALSE; + FL.Add( AParent ); + AParent.Enabled := FALSE; end; ModalResult := 0; @@ -50265,8 +49958,8 @@ begin {$ENDIF} end; - AParent.fModalForm := OldMF; - Dec( fModal ); + AParent.DF.fModalForm := OldMF; + Dec( DF.fModal ); for I := 0 to FL.Count - 1 do begin F := PControl( FL.Items[ I ] ); @@ -50281,7 +49974,6 @@ begin end; {$ENDIF NEW_MODAL} -//[function DisableWindows] function DisableWindows( W: hwnd; LPARAM: Integer ): Bool; stdcall; var FL: PList; Buf: Array[ 0..127 ] of AnsiChar; @@ -50299,7 +49991,6 @@ begin Result := TRUE; end; -//[function TControl.ShowModalEx] function TControl.ShowModalEx: Integer; var FL: PList; var CurForm: PControl; @@ -50308,29 +49999,33 @@ var CurForm: PControl; CurCtl: PControl; { Alexander Pravdin } begin Result := 0; - if (fIsControl) or (fParent = nil) then + if {$IFDEF USE_FLAGS} (G3_IsControl in fFlagsG3) + {$ELSE} (fIsControl) {$ENDIF} + or (fParent = nil) then begin Show; Exit; end; AttachProc( WndProcShowModal ); - CurForm := Applet.fCurrentControl; + CurForm := Applet.DF.fCurrentControl; FL := NewList; FL.Tag := fHandle; // ++++ { Alexander Pravdin } - if not Applet.fIsApplet then CurCtl := Applet.fCurrentControl - else CurCtl := nil; + if {$IFDEF USE_FLAGS} not(G3_IsApplet in Applet.fFlagsG3) + {$ELSE} not Applet.fIsApplet {$ENDIF} then + CurCtl := Applet.DF.fCurrentControl + else CurCtl := nil; // ---- CreateWindow; EnumThreadWindows( GetCurrentThreadID, @ DisableWindows, Integer( FL ) ); Enabled := TRUE; - Inc( fModal ); - Applet.fModalForm := @ Self; + Inc( DF.fModal ); + Applet.DF.fModalForm := @ Self; Show; - ModalResult := 0; - while not AppletTerminated and (ModalResult = 0) do + DF.fModalResult := 0; + while not AppletTerminated and (DF.fModalResult = 0) do begin WaitMessage; Applet.ProcessMessages; @@ -50339,8 +50034,8 @@ begin {$ENDIF} end; - Dec( fModal ); - Applet.fModalForm := @ Self; + Dec( DF.fModal ); + Applet.DF.fModalForm := @ Self; DetachProc( WndProcShowModal ); @@ -50357,20 +50052,17 @@ begin Result := ModalResult; end; -//[function TControl.GetModal] function TControl.GetModal: Boolean; begin - Result := fModal > 0; + Result := DF.fModal > 0; end; {$IFDEF USE_SETMODALRESULT} -//[procedure TControl.SetModalResult] procedure TControl.SetModalResult( const Value: Integer ); begin - //if fModal <= 0 then Exit; - fModalResult := Value; - if Value <> 0 then - PostMessage( GetWindowHandle, 0, 0, 0 ); + DF.fModalResult := Value; + if Value <> 0 then + PostMessage( GetWindowHandle, 0, 0, 0 ); end; {$ENDIF} @@ -50389,31 +50081,32 @@ end; {$IFDEF _X_} {$IFDEF GTK} -function control_clicked( Obj: PGtkWidget; Sender: PControl ): Boolean; cdecl; -begin - if Assigned( Sender.fOnClick ) then - Sender.fOnClick( Sender ); +FUNCTION control_clicked( Obj: PGtkWidget; Sender: PControl ): Boolean; cdecl; +BEGIN + IF Assigned( Sender.fOnClick ) THEN + Sender.fOnClick( Sender ); Result := FALSE; -end; +END; +{$ENDIF GTK} +{$ENDIF _X_} procedure TControl.SetOnClick( const Value: TOnEvent ); begin - fOnClick := Value; - if fEventboxHandle = fHandle then - begin + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnClick := Value; + {$IFDEF GTK} + IF fEventboxHandle = fHandle THEN + BEGIN {$IFNDEF SMALLER_CODE} - if not Assigned( Value ) then + IF NOT Assigned( Value ) THEN gtk_signal_disconnect( GTK_OBJECT( fEventboxHandle ), fClickedEvent ) - else + ELSE {$ENDIF SMALLEST_CODE} fClickedEvent := gtk_signal_connect( GTK_OBJECT( fEventboxHandle ), 'clicked', @ control_clicked, @ Self ) - end - else - SetMouseEvent( @ Self, 'button_release_event' ); + END ELSE SetMouseEvent( @ Self, 'button_release_event' ); + {$ENDIF GTK} end; -{$ENDIF GTK} -{$ENDIF _X_} ////////////////////////////////////////////////////////////////// // T I M E R ////////////////////////////////////////////////////////////////// @@ -50423,43 +50116,37 @@ var {$IFDEF WIN} TimerOwnerWnd: PControl; {$ENDIF} // in Linux, timer not need i { -- Constructor of timer -- } -//[function NewTimer] function NewTimer( Interval: Integer ): PTimer; begin - {-} New( Result, Create ); - {+}{++}(*Result := PTimer.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TTimer'; + {$ENDIF} if Interval <= 0 then Interval := 1000; Result.fInterval := Interval; Inc( TimerCount ); end; -//[END NewTimer] { -- Timer procedure -- } {$IFDEF WIN} -//[FUNCTION TimerProc] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TimerProc( Wnd : HWnd; Msg : Integer; T : PTimer; CurrentTime : DWord ): Integer; stdcall; begin {$IFDEF STOPTIMER_AFTER_APPLETTERMINATED} if not AppletTerminated then {$ENDIF} - if Assigned( T.fOnTimer ) then - T.fOnTimer( T ); + if Assigned( T.fOnTimer ) then + T.fOnTimer( T ); Result := 0; end; {$ENDIF ASM_VERSION} -//[END TimerProc] {$ENDIF WIN} { TTimer } -//[destructor TTimer.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TTimer.Destroy; begin Enabled := False; @@ -50475,10 +50162,8 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TTimer.SetEnabled] {$IFDEF WIN_GDI} -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TTimer.SetEnabled(const Value: Boolean); var WasEnabled: Boolean; begin @@ -50497,9 +50182,12 @@ begin {$ELSE} if TimerOwnerWnd = nil then begin - TimerOwnerWnd := _NewWindowed( nil, '', TRUE ); - TimerOwnerWnd.fStyle := 0; - TimerOwnerWnd.fIsControl := TRUE; + TimerOwnerWnd := _NewWindowed( nil, '', TRUE, + {$IFDEF PACK_COMMANDACTIONS} PAnsiChar( OTHER_ACTIONS ) + {$ELSE} nil {$ENDIF} ); + TimerOwnerWnd.fStyle.Value := 0; + {$IFDEF USE_FLAGS} include( TimerOwnerWnd.fFlagsG3, G3_IsControl ); + {$ELSE} TimerOwnerWnd.fIsControl := TRUE; {$ENDIF} end; fHandle := SetTimer( TimerOwnerWnd.GetWindowHandle, Integer( @Self ), fInterval, @TimerProc ); @@ -50520,37 +50208,36 @@ end; {$IFDEF _X_} {$IFDEF GTK} -function TimerGTKTick( Sender: Pointer ): LONGBOOL; cdecl; -begin - if not PTimer( Sender ).fEnabled then Result := FALSE - else - begin - if Assigned( PTimer( Sender ).fOnTimer ) then - Ptimer( Sender ).fOnTimer( Sender ); +FUNCTION TimerGTKTick( Sender: Pointer ): LONGBOOL; cdecl; +BEGIN + IF NOT PTimer( Sender ).fEnabled THEN Result := FALSE + ELSE + BEGIN + IF Assigned( PTimer( Sender ).fOnTimer ) THEN + Ptimer( Sender ).fOnTimer( Sender ); Result := PTimer( Sender ).fEnabled; - end; - if Result then - PTimer( Sender ).RefDec; -end; + END; + IF Result THEN + PTimer( Sender ).RefDec; +END; -procedure TTimer.SetEnabled(const Value: Boolean); -begin - if FEnabled = Value then Exit; +PROCEDURE TTimer.SetEnabled(const Value: Boolean); +BEGIN + IF FEnabled = Value THEN Exit; fEnabled := Value; - if Value then - begin - RefInc; - fHandle := gtk_timeout_add( fInterval, TimerGTKTick, @ Self ); - end - else - begin - if AppletTerminated then - begin - gtk_timeout_remove( fHandle ); - RefDec; - end; - end; -end; + IF Value THEN + BEGIN + RefInc; + fHandle := gtk_timeout_add( fInterval, TimerGTKTick, @ Self ); + END ELSE + BEGIN + IF AppletTerminated THEN + BEGIN + gtk_timeout_remove( fHandle ); + RefDec; + END; + END; +END; {$ELSE not GTK} var fActiveTimerList: PTimer; fClockPerSecond: Integer; @@ -50726,7 +50413,6 @@ const type TFNTimeCallBack = procedure(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD) stdcall; -//[API timeSetEvent] function timeSetEvent(uDelay, uResolution: UINT; lpFunction: TFNTimeCallBack; dwUser: DWORD; uFlags: UINT): THandle; stdcall; external 'winmm.dll' name 'timeSetEvent'; @@ -50734,7 +50420,6 @@ function timeKillEvent(uTimerID: UINT): Integer; stdcall; external 'winmm.dll' name 'timeKillEvent'; { ----------------------------------------------------------------------- } -//[procedure MMTimerCallback] procedure MMTimerCallback(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall; var MMTimer: PMMTimer; @@ -50744,18 +50429,16 @@ begin MMTimer.fOnTimer( MMTimer ); end; -//[function NewMMTimer] function NewMMTimer( Interval: Integer ): PMMTimer; begin - {-} New( Result, Create ); - {+} {++}(* Result := PMMTimer.Create; *){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TMMTimer'; + {$ENDIF} Result.fInterval := Interval; Result.FPeriodic := TRUE; end; -//[END NewMMTimer] -//[destructor TMMTimer.Destroy] destructor TMMTimer.Destroy; begin Enabled := FALSE; @@ -50763,7 +50446,6 @@ begin inherited; end; -//[procedure TMMTimer.SetEnabled] procedure TMMTimer.SetEnabled(const Value: Boolean); begin if Value xor (fHandle <> 0) then @@ -50801,9 +50483,7 @@ end; { -- bitmap -- } -//[FUNCTION PrepareBitmapHeader] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function PrepareBitmapHeader( W, H, BitsPerPixel: Integer ): PBitmapInfo; begin Assert( W > 0, 'Width must be >0' ); @@ -50817,15 +50497,12 @@ begin Result.bmiHeader.biBitCount := BitsPerPixel; end; {$ENDIF ASM_VERSION} -//[END PrepareBitmapHeader] const BitsPerPixel_By_PixelFormat: array[ TPixelFormat ] of Byte = ( 0, 1, 4, 8, 16, 16, 24, 32, 0 ); -//[FUNCTION Bits2PixelFormat] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function Bits2PixelFormat( BitsPerPixel: Integer ): TPixelFormat; var I: TPixelFormat; begin @@ -50838,22 +50515,19 @@ begin Result := pfDevice; end; {$ENDIF ASM_VERSION} -//[END Bits2PixelFormat] -//[procedure DummyDetachCanvas] procedure DummyDetachCanvas( Sender: PBitmap ); begin end; -//[FUNCTION NewBitmap] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewBitmap( W, H: Integer ): PBitmap; var DC: HDC; begin - {-} New( Result, Create ); - {+}{++}(*Result := PBitmap.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TBitmap'; + {$ENDIF} Result.fHandleType := bmDDB; Result.fDetachCanvas := DummyDetachCanvas; Result.fWidth := W; @@ -50867,32 +50541,27 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END NewBitmap] const InitColors: array[ 0..17 ] of DWORD = ( $F800, $7E0, $1F, 0, $800000, $8000, $808000, $80, $800080, $8080, $808080, $C0C0C0, $FF0000, $FF00, $FFFF00, $FF, $FF00FF, $FFFF ); -//[PROCEDURE PreparePF16bit] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure PreparePF16bit( DIBHeader: PBitmapInfo ); begin DIBHeader.bmiHeader.biCompression := BI_BITFIELDS; Move( InitColors[ 0 ], DIBHeader.bmiColors[ 0 ], 19*Sizeof(TRGBQUAD) ); end; {$ENDIF ASM_VERSION} -//[END PreparePF16bit] -//[FUNCTION NewDIBBitmap] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function NewDIBBitmap( W, H: Integer; PixelFormat: TPixelFormat ): PBitmap; const BitsPerPixel: array[ TPixelFormat ] of Byte = ( 0, 1, 4, 8, 16, 16, 24, 32, 0 ); var BitsPixel: Integer; begin - {-} New( Result, Create ); - {+}{++}(*Result := PBitmap.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TBitmap:DIBBitmap'; + {$ENDIF} Result.fDetachCanvas := DummyDetachCanvas; Result.fWidth := W; Result.fHeight := H; @@ -50920,13 +50589,10 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END NewDIBBitmap] { TBitmap } -//[procedure TBitmap.ClearData] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.ClearData; begin fDetachCanvas( @Self ); @@ -50954,9 +50620,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.Clear] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.Clear; begin RemoveCanvas; @@ -50967,15 +50631,12 @@ begin end; {$ENDIF ASM_VERSION} -//[function TBitmap.GetBoundsRect] function TBitmap.GetBoundsRect: TRect; begin Result := MakeRect( 0, 0, Width, Height ); end; -//[destructor TBitmap.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TBitmap.Destroy; begin Clear; @@ -50983,7 +50644,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TBitmap.BitsPerPixel] function TBitmap.BitsPerPixel: Integer; var B: tagBitmap; begin @@ -51004,9 +50664,7 @@ begin END; end; -//[procedure TBitmap.Draw] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.Draw(DC: HDC; X, Y: Integer); var DCfrom, DC0: HDC; @@ -51055,9 +50713,7 @@ TRYAgain: end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.StretchDraw] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.StretchDraw(DC: HDC; const Rect: TRect); var DCfrom: HDC; oldBmp: HBitmap; @@ -51091,15 +50747,12 @@ DrawHandle: end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.DrawMasked] procedure TBitmap.DrawMasked(DC: HDC; X, Y: Integer; Mask: HBitmap); begin StretchDrawMasked( DC, MakeRect( X, Y, X + fWidth, Y + fHeight ), Mask ); end; -//[procedure TBitmap.DrawTransparent] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.DrawTransparent(DC: HDC; X, Y: Integer; TranspColor: TColor); begin if TranspColor = clNone then @@ -51110,9 +50763,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.StretchDrawTransparent] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.StretchDrawTransparent(DC: HDC; const Rect: TRect; TranspColor: TColor); begin if TranspColor = clNone then @@ -51151,9 +50802,7 @@ end; const ROP_DstCopy = $00AA0029; -//[procedure TBitmap.StretchDrawMasked] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.StretchDrawMasked(DC: HDC; const Rect: TRect; Mask: HBitmap); var DCfrom, MemDC, MaskDC: HDC; @@ -51222,16 +50871,13 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure ApplyBitmapBkColor2Canvas] procedure ApplyBitmapBkColor2Canvas( Sender: PBitmap ); begin if Sender.fCanvas = nil then Exit; Sender.fCanvas.Brush.Color := Sender.BkColor; end; -//[PROCEDURE DetachBitmapFromCanvas] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure DetachBitmapFromCanvas( Sender: PBitmap ); begin if Sender.fCanvasAttached = 0 then Exit; @@ -51239,11 +50885,8 @@ begin Sender.fCanvasAttached := 0; end; {$ENDIF ASM_VERSION} -//[END DetachBitmapFromCanvas] -//[function TBitmap.GetCanvas] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.GetCanvas: PCanvas; var DC: HDC; begin @@ -51278,9 +50921,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TBitmap.GetEmpty] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.GetEmpty: Boolean; begin Result := (fWidth = 0) or (fHeight = 0); @@ -51289,7 +50930,6 @@ end; {$ENDIF ASM_VERSION} {$IFDEF ASM_noVERSION} -//[function TBitmap.GetHandle] function TBitmap.GetHandle: HBitmap; asm PUSH EBX @@ -51384,15 +51024,12 @@ begin end; {$ENDIF ASM_VERSION} -//[function TBitmap.GetHandleAllocated] function TBitmap.GetHandleAllocated: Boolean; begin Result := fHandle <> 0; end; -//[procedure TBitmap.LoadFromFile] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.LoadFromFile(const Filename: KOLString); var Strm: PStream; begin @@ -51402,13 +51039,11 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.LoadFromResourceID] procedure TBitmap.LoadFromResourceID(Inst: DWORD; ResID: Integer); begin LoadFromResourceName( Inst, MAKEINTRESOURCE( ResID ) ); end; -//[procedure TBitmap.LoadFromResourceName] {$IFDEF ASM_UNICODE} procedure TBitmap.LoadFromResourceName(Inst: DWORD; ResName: PAnsiChar); asm @@ -51466,7 +51101,6 @@ type {$ENDIF} {$IFDEF ASM_noVERSION} // error + 16Colors->swap(Gray,Silver) + Core -//[procedure TBitmap.LoadFromStream] procedure TBitmap.LoadFromStream(Strm: PStream); type tBFH = TBitmapFileHeader; tBIH = TBitmapInfoHeader; @@ -51807,7 +51441,6 @@ end; ////////////////// bitmap RLE-decoding and loading - by Vyacheslav A. Gavrik -//[procedure DecodeRLE4] // by Vyacheslav A. Gavrik procedure DecodeRLE4(Bmp:PBitmap;Data:Pointer; MaxSize: DWORD); procedure OddMove(Src,Dst:PByte;Size:Integer); @@ -51882,7 +51515,6 @@ begin end; end; -//[procedure DecodeRLE8] // by Vyacheslav A. Gavrik procedure DecodeRLE8(Bmp:PBitmap;Data:Pointer; MaxSize: DWORD); var @@ -51930,7 +51562,6 @@ begin end; end; -//[function TBitmap.LoadFromFileEx] function TBitmap.LoadFromFileEx(const Filename: KOLString): Boolean; // by Vyacheslav A. Gavrik var Strm: PStream; begin @@ -51939,7 +51570,6 @@ begin Strm.Free; end; -//[function TBitmap.LoadFromStreamEx] function TBitmap.LoadFromStreamEx(Strm: PStream): Boolean; // by Vyacheslav A. Gavrik var Pos : DWORD; i: Integer; @@ -52171,9 +51801,7 @@ end; /////////////////////////// -//[function TBitmap.ReleaseHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.ReleaseHandle: HBitmap; var OldBits: Pointer; begin @@ -52191,9 +51819,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.SaveToFile] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.SaveToFile(const Filename: KOLString); var Strm: PStream; begin @@ -52204,7 +51830,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.SaveToStream] {$IFDEF ASM_STREAM} procedure TBitmap.SaveToStream(Strm: PStream); type tBFH = TBitmapFileHeader; @@ -52326,9 +51951,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.SetHandle] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.SetHandle(const Value: HBitmap); var B: tagBitmap; Dib: TDIBSection; @@ -52360,7 +51983,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.SetWidth] procedure TBitmap.SetWidth(const Value: Integer); begin if fWidth = Value then Exit; @@ -52368,9 +51990,7 @@ begin FormatChanged; end; -//[procedure TBitmap.SetHeight] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.SetHeight(const Value: Integer); {$IFNDEF SMALLER_CODE} var @@ -52393,9 +52013,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.SetPixelFormat] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.SetPixelFormat(Value: TPixelFormat); begin if PixelFormat = Value then Exit; @@ -52411,25 +52029,20 @@ begin end; {$ENDIF ASM_VERSION} -//[FUNCTION CalcScanLineSize] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function CalcScanLineSize( Header: PBitmapInfoHeader ): Integer; begin Result := ((Header.biBitCount * Header.biWidth + 31) shr 3) and $FFFFFFFC; end; {$ENDIF ASM_VERSION} -//[END CalcScanLineSize] -//[PROCEDURE FillBmpWithBkColor] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure FillBmpWithBkColor( Bmp: PBitmap; DC2: HDC; oldWidth, oldHeight: Integer ); var oldBmp: HBitmap; R: TRect; Br: HBrush; begin - with Bmp{-}^{+} do + with Bmp^ do if Color2RGB( fBkColor ) <> 0 then if (oldWidth < fWidth) or (oldHeight < fHeight) then if GetHandle <> 0 then @@ -52438,22 +52051,19 @@ begin ASSERT( oldBmp <> 0, 'Can not select bitmap to DC' ); Br := CreateSolidBrush( Color2RGB( fBkColor ) ); R := MakeRect( oldWidth, oldHeight, fWidth, fHeight ); - if oldWidth = fWidth then - R.Left := 0; - if oldHeight = fHeight then - R.Top := 0; + if oldWidth = fWidth then + R.Left := 0; + if oldHeight = fHeight then + R.Top := 0; Windows.FillRect( DC2, R, Br ); DeleteObject( Br ); SelectObject( DC2, oldBmp ); end; end; {$ENDIF ASM_VERSION} -//[END FillBmpWithBkColor] const BitCounts: array[ TPixelFormat ] of Byte = ( 0, 1, 4, 8, 16, 16, 24, 32, 0 ); -//[procedure TBitmap.FormatChanged] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.FormatChanged; // This method is used whenever Width, Height, PixelFormat or HandleType // properties are changed. @@ -52584,9 +52194,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TBitmap.GetScanLine] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.GetScanLine(Y: Integer): Pointer; begin ASSERT( (Y >= 0) {and (Y < fHeight)}, 'ScanLine index out of bounds' ); @@ -52603,9 +52211,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TBitmap.GetScanLineSize] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.GetScanLineSize: Integer; begin Result := 0; @@ -52615,9 +52221,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.CanvasChanged] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.CanvasChanged( Sender : PObj ); begin fBkColor := PCanvas( Sender ).Brush.Color; @@ -52625,9 +52229,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.Dormant] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.Dormant; begin RemoveCanvas; @@ -52636,22 +52238,18 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.SetBkColor] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.SetBkColor(const Value: TColor); begin if fBkColor = Value then Exit; fBkColor := Value; fFillWithBkColor := FillBmpWithBkColor; - if Assigned( fApplyBkColor2Canvas ) then - fApplyBkColor2Canvas( @Self ); + if Assigned( fApplyBkColor2Canvas ) then + fApplyBkColor2Canvas( @Self ); end; {$ENDIF ASM_VERSION} -//[function TBitmap.Assign] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.Assign(SrcBmp: PBitmap): Boolean; begin Clear; @@ -52683,9 +52281,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.RemoveCanvas] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.RemoveCanvas; begin fDetachCanvas( @Self ); @@ -52694,9 +52290,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TBitmap.DIBPalNearestEntry] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.DIBPalNearestEntry(Color: TColor): Integer; var I, Diff, D: Integer; C : Integer; @@ -52718,9 +52312,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TBitmap.GetDIBPalEntries] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.GetDIBPalEntries(Idx: Integer): TColor; begin Result := TColor(-1); @@ -52733,9 +52325,7 @@ begin end; {$ENDIF ASM_VERSION} -//[function TBitmap.GetDIBPalEntryCount] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.GetDIBPalEntryCount: Integer; begin Result := 0; @@ -52749,7 +52339,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.SetDIBPalEntries] procedure TBitmap.SetDIBPalEntries(Idx: Integer; const Value: TColor); begin if fDIBBits = nil then Exit; @@ -52758,7 +52347,6 @@ begin + Idx * Sizeof( TRGBQuad ) )^ := Color2RGB( Value ); end; -//[procedure TBitmap.SetHandleType] procedure TBitmap.SetHandleType(const Value: TBitmapHandleType); begin if fHandleType = Value then Exit; @@ -52766,7 +52354,6 @@ begin FormatChanged; end; -//[function TBitmap.GetPixelFormat] function TBitmap.GetPixelFormat: TPixelFormat; begin if (HandleType = bmDDB) or (fDIBBits = nil) then @@ -52792,9 +52379,7 @@ begin end; end; -//[procedure TBitmap.ClearTransImage] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.ClearTransImage; begin fTransColor := clNone; @@ -52803,9 +52388,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.Convert2Mask] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal {$IFDEF USE_OLDCONVERT2MASK} procedure TBitmap.Convert2Mask(TranspColor: TColor); var MonoHandle: HBitmap; @@ -52991,7 +52574,6 @@ end; {$ENDIF USE_OLDCONVERT2MASK} //Pascal {$ENDIF ASM_VERSION} -//[procedure TBitmap.Invert] procedure TBitmap.Invert; var R: TRect; begin @@ -53000,7 +52582,6 @@ begin InvertRect(Canvas.Handle, R); end; -//[procedure TBitmap.DIBDrawRect] procedure TBitmap.DIBDrawRect( DC: HDC; X, Y: Integer; const R: TRect ); begin if fDIBBits = nil then Exit; @@ -53009,9 +52590,7 @@ begin fDIBBits, fDIBHeader^, DIB_RGB_COLORS, SRCCOPY ); end; -//[PROCEDURE _RotateBitmapMono] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure _RotateBitmapMono( var DstBmp: PBitmap; SrcBmp: PBitmap ); var X, Y, Z, Shf, Wbytes, BytesPerDstLine: Integer; Src, Dst, Dst1: PByte; @@ -53054,11 +52633,8 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END _RotateBitmapMono] -//[PROCEDURE _RotateBitmap4bit] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure _RotateBitmap4bit( var DstBmp: PBitmap; SrcBmp: PBitmap ); var X, Y, Shf, Wbytes, BytesPerDstLine: Integer; Src, Dst, Dst1: PByte; @@ -53097,11 +52673,8 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END _RotateBitmap4bit] -//[PROCEDURE _RotateBitmap8bit] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure _RotateBitmap8bit( var DstBmp: PBitmap; SrcBmp: PBitmap ); var X, Y, Wbytes, BytesPerDstLine: Integer; Src, Dst, Dst1: PByte; @@ -53135,11 +52708,8 @@ begin end; {$ENDIF ASM_VERSION} -//[END _RotateBitmap8bit] -//[PROCEDURE _RotateBitmap16bit] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure _RotateBitmap16bit( var DstBmp: PBitmap; SrcBmp: PBitmap ); var X, Y, Wwords, BytesPerDstLine: Integer; Src, Dst, Dst1: PWord; @@ -53167,11 +52737,8 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END _RotateBitmap16bit] -//[PROCEDURE _RotateBitmap2432bit] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure _RotateBitmap2432bit( var DstBmp: PBitmap; SrcBmp: PBitmap ); var X, Y, Wwords, BytesPerDstLine, IncW: Integer; Src, Dst, Dst1: PDWord; @@ -53207,7 +52774,6 @@ begin end; {$ENDIF ASM_VERSION} -//[END _RotateBitmap2432bit] type TRotateBmpRefs = packed record @@ -53221,9 +52787,7 @@ type var RotateProcs: TRotateBmpRefs; -//[PROCEDURE _RotateBitmapRight] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure _RotateBitmapRight( SrcBmp: PBitmap ); var DstBmp: PBitmap; RotateProc: procedure( var DstBmp: PBitmap; SrcBmp: PBitmap ); @@ -53267,9 +52831,7 @@ begin DstBmp.Free; end; {$ENDIF ASM_VERSION} -//[END _RotateBitmapRight] -//[procedure TBitmap.RotateRight] procedure TBitmap.RotateRight; const AllRotators: TRotateBmpRefs = ( proc_RotateBitmapMono: _RotateBitmapMono; @@ -53282,7 +52844,6 @@ begin _RotateBitmapRight( @Self ); end; -//[procedure _RotateBitmapLeft] procedure _RotateBitmapLeft( Src: PBitmap ); begin _RotateBitmapRight( Src ); @@ -53290,7 +52851,6 @@ begin _RotateBitmapRight( Src ); end; -//[procedure TBitmap.RotateLeft] procedure TBitmap.RotateLeft; begin RotateRight; @@ -53298,7 +52858,6 @@ begin _RotateBitmapRight( @Self ); end; -//[procedure TBitmap.RotateLeftMono] procedure TBitmap.RotateLeftMono; begin if PixelFormat <> pf1bit then Exit; @@ -53306,7 +52865,6 @@ begin _RotateBitmapRight( @Self ); end; -//[procedure TBitmap.RotateRightMono] procedure TBitmap.RotateRightMono; begin if PixelFormat <> pf1bit then Exit; @@ -53314,7 +52872,6 @@ begin _RotateBitmapLeft( @Self ); end; -//[procedure TBitmap.RotateLeft16bit] procedure TBitmap.RotateLeft16bit; begin if PixelFormat <> pf16bit then Exit; @@ -53322,7 +52879,6 @@ begin _RotateBitmapLeft( @Self ); end; -//[procedure TBitmap.RotateLeft4bit] procedure TBitmap.RotateLeft4bit; begin if PixelFormat <> pf4bit then Exit; @@ -53330,7 +52886,6 @@ begin _RotateBitmapLeft( @Self ); end; -//[procedure TBitmap.RotateLeft8bit] procedure TBitmap.RotateLeft8bit; begin if PixelFormat <> pf8bit then Exit; @@ -53338,7 +52893,6 @@ begin _RotateBitmapLeft( @Self ); end; -//[procedure TBitmap.RotateLeftTrueColor] procedure TBitmap.RotateLeftTrueColor; begin if not (PixelFormat in [ pf24bit, pf32bit ]) then Exit; @@ -53346,7 +52900,6 @@ begin _RotateBitmapLeft( @Self ); end; -//[procedure TBitmap.RotateRight16bit] procedure TBitmap.RotateRight16bit; begin if PixelFormat <> pf16bit then Exit; @@ -53354,7 +52907,6 @@ begin _RotateBitmapRight( @Self ); end; -//[procedure TBitmap.RotateRight4bit] procedure TBitmap.RotateRight4bit; begin if PixelFormat <> pf4bit then Exit; @@ -53362,7 +52914,6 @@ begin _RotateBitmapRight( @Self ); end; -//[procedure TBitmap.RotateRight8bit] procedure TBitmap.RotateRight8bit; begin if PixelFormat <> pf8bit then Exit; @@ -53370,7 +52921,6 @@ begin _RotateBitmapRight( @Self ); end; -//[procedure TBitmap.RotateRightTrueColor] procedure TBitmap.RotateRightTrueColor; begin if not (PixelFormat in [ pf24bit, pf32bit ]) then Exit; @@ -53378,9 +52928,7 @@ begin _RotateBitmapRight( @Self ); end; -//[function TBitmap.GetPixels] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.GetPixels(X, Y: Integer): TColor; var DC: HDC; Save: THandle; @@ -53398,9 +52946,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.SetPixels] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.SetPixels(X, Y: Integer; const Value: TColor); var DC: HDC; Save: THandle; @@ -53417,9 +52963,7 @@ begin end; {$ENDIF ASM_VERSION} -//[FUNCTION _GetDIBPixelsPalIdx] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function _GetDIBPixelsPalIdx( Bmp: PBitmap; X, Y: Integer ): TColor; var Pixel: Byte; begin @@ -53432,11 +52976,8 @@ begin + Pixel * Sizeof( TRGBQuad ) )^ ) ) ); end; {$ENDIF ASM_VERSION} -//[END _GetDIBPixelsPalIdx] -//[FUNCTION _GetDIBPixels16bit] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function _GetDIBPixels16bit( Bmp: PBitmap; X, Y: Integer ): TColor; var Pixel: Word; begin @@ -53449,11 +52990,8 @@ begin or (Pixel shl 19) and $F80000; end; {$ENDIF ASM_VERSION} -//[END _GetDIBPixels16bit] -//[FUNCTION _GetDIBPixelsTrueColor] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function _GetDIBPixelsTrueColor( Bmp: PBitmap; X, Y: Integer ): TColor; var Pixel: DWORD; begin @@ -53462,9 +53000,7 @@ begin Result := TColor( Color2RGBQuad( TColor( Pixel ) ) ); end; {$ENDIF ASM_VERSION} -//[END _GetDIBPixelsTrueColor] -//[FUNCTION _GetDIBPixelsTrueColorWithAlpha] function _GetDIBPixelsTrueColorWithAlpha( Bmp: PBitmap; X, Y: Integer ): TColor; var Pixel: DWORD; @@ -53476,11 +53012,8 @@ begin Swap(RGB.rgbBlue, RGB.rgbRed); Result := TColor( RGB ); end; -//[END _GetDIBPixelsTrueColorWithAlpha] -//[function TBitmap.GetDIBPixels] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TBitmap.GetDIBPixels(X, Y: Integer): TColor; begin if not Assigned( fGetDIBPixels ) then @@ -53528,7 +53061,7 @@ begin begin fPixelsPerByteMask := 1; fBytesPerPixel := 4; - fGetDIBPixels := {$IFDEF FIXDIB32}_GetDIBPixelsTrueColorWithAlpha{$ELSE}_GetDIBPixelsTrueColor{$ENDIF}; + fGetDIBPixels := _GetDIBPixelsTrueColorWithAlpha; end; else; end; @@ -53543,9 +53076,7 @@ begin end; {$ENDIF ASM_VERSION} -//[PROCEDURE _SetDIBPixels1bit] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure _SetDIBPixels1bit( Bmp: PBitmap; X, Y: Integer; Value: TColor ); var Pixel: Byte; Pos: PByte; @@ -53559,11 +53090,8 @@ begin Pos^ := Pos^ and ($FF7F shr Shf) or (Pixel shr Shf); end; {$ENDIF ASM_VERSION} -//[END _SetDIBPixels1bit] -//[PROCEDURE _SetDIBPixelsPalIdx] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure _SetDIBPixelsPalIdx( Bmp: PBitmap; X, Y: Integer; Value: TColor ); var Pixel: Byte; Pos: PByte; @@ -53577,11 +53105,8 @@ begin Pos^ := Pos^ and not (Bmp.fPixelMask shl Shf) or (Pixel shl Shf); end; {$ENDIF ASM_VERSION} -//[END _SetDIBPixelsPalIdx] -//[PROCEDURE _SetDIBPixels16bit] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure _SetDIBPixels16bit( Bmp: PBitmap; X, Y: Integer; Value: TColor ); var RGB16: Word; Pos: PWord; @@ -53597,11 +53122,8 @@ begin Pos^ := RGB16; end; {$ENDIF ASM_VERSION} -//[END _SetDIBPixels16bit] -//[PROCEDURE _SetDIBPixelsTrueColor] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure _SetDIBPixelsTrueColor( Bmp: PBitmap; X, Y: Integer; Value: TColor ); var RGB: TRGBQuad; Pos: PDWord; @@ -53612,25 +53134,20 @@ begin Pos^ := Pos^ and $FF000000 or DWORD(RGB); 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)); + RGB := TRGBQuad(Value); Swap(RGB.rgbBlue, RGB.rgbRed); Pos := PDWORD( Integer(Bmp.fScanLine0) + Y * Bmp.fScanLineDelta + X * Bmp.fBytesPerPixel ); - Pos^ := Pos^ {and $FF000000} or DWORD(RGB); + Pos^ := Pos^ or DWORD(RGB); end; -//[END _SetDIBPixelsTrueColorWithAlpha] -//[procedure TBitmap.SetDIBPixels] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.SetDIBPixels(X, Y: Integer; const Value: TColor); begin if not Assigned( fSetDIBPixels ) then @@ -53678,7 +53195,7 @@ begin begin fPixelsPerByteMask := 1; fBytesPerPixel := 4; - fSetDIBPixels := {$IFDEF FIXDIB32}_SetDIBPixelsTrueColorWithAlpha{$ELSE}_SetDIBPixelsTrueColor{$ENDIF}; + fSetDIBPixels := _SetDIBPixelsTrueColorWithAlpha; end; else; end; @@ -53693,9 +53210,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.FlipVertical] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.FlipVertical; var DC: HDC; Save: THandle; @@ -53725,9 +53240,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.FlipHorizontal] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.FlipHorizontal; var DC: HDC; Save: THandle; @@ -53744,70 +53257,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TBitmap.CopyRect] -{$IFDEF ASM_VERSION} -procedure TBitmap.CopyRect(const DstRect: TRect; SrcBmp: PBitmap; - const SrcRect: TRect); -asm - PUSHAD - MOV EBX, EAX - MOV ESI, ECX - MOV EDI, EDX - CALL GetHandle - TEST EAX, EAX - JZ @@exit - MOV EAX, ESI - CALL GetHandle - TEST EAX, EAX - JZ @@exit - CALL StartDC - XCHG EBX, ESI - CMP EBX, ESI - JNZ @@diff1 - PUSH EAX - PUSH 0 - JMP @@nodiff1 -@@diff1: - CALL StartDC -@@nodiff1: - PUSH SrcCopy // -> - MOV EBP, [SrcRect] - MOV EAX, [EBP].TRect.Bottom - MOV EDX, [EBP].TRect.Top - SUB EAX, EDX - PUSH EAX // -> - MOV EAX, [EBP].TRect.Right - MOV ECX, [EBP].TRect.Left - SUB EAX, ECX - PUSH EAX // -> - PUSH EDX // -> - PUSH ECX // -> - PUSH dword ptr [ESP+24] // -> DCsrc - MOV EAX, [EDI].TRect.Bottom - MOV EDX, [EDI].TRect.Top - SUB EAX, EDX - PUSH EAX // -> - MOV EAX, [EDI].TRect.Right - MOV ECX, [EDI].TRect.Left - SUB EAX, ECX - PUSH EAX // -> - PUSH EDX // -> - PUSH ECX // -> - PUSH dword ptr [ESP+13*4] // -> DCdst - CALL StretchBlt - CMP EBX, ESI - JNE @@diff2 - POP ECX - POP ECX - JMP @@nodiff2 -@@diff2: - CALL FinishDC -@@nodiff2: - CALL FinishDC -@@exit: - POPAD -end; -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TBitmap.CopyRect(const DstRect: TRect; SrcBmp: PBitmap; const SrcRect: TRect); var DCsrc, DCdst: HDC; @@ -53839,7 +53289,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TBitmap.CopyToClipboard] function TBitmap.CopyToClipboard: Boolean; var DibMem: PAnsiChar; HdrSize: Integer; @@ -53899,7 +53348,6 @@ begin CloseClipboard; end; -//[function TBitmap.PasteFromClipboard] function TBitmap.PasteFromClipboard: Boolean; var Gbl: HGlobal; //DIBPtr: PAnsiChar; @@ -53945,12 +53393,12 @@ end; { -- icon -- } -//[function NewIcon] function NewIcon: PIcon; begin - {-} New( Result, Create ); - {+}{++}(*Result := TIcon.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TIcon'; + {$ENDIF} {$IFDEF ICON_DIFF_WH} Result.FWidth := 32; Result.FHeight := 32; @@ -53961,14 +53409,7 @@ end; { TIcon } -//[PROCEDURE asmIconEmpty] -{$IFDEF ASM_VERSION} -{$ENDIF ASM_VERSION} -//[END asmIconEmpty] - -//[procedure TIcon.Clear] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TIcon.Clear; begin if fHandle <> 0 then @@ -53989,7 +53430,6 @@ end; {$IFDEF ASM_VERSION} {$DEFINE ASM_LOCAL} {$ENDIF} {$ENDIF} -//[function TIcon.Convert2Bitmap] {$IFDEF ASM_LOCAL} {$ELSE ASM_VERSION} //Pascal function TIcon.Convert2Bitmap(TranColor: TColor): HBitmap; @@ -54021,9 +53461,7 @@ begin end; {$ENDIF ASM_VERSION} -//[destructor TIcon.Destroy] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal destructor TIcon.Destroy; begin Clear; @@ -54031,9 +53469,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TIcon.Draw] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TIcon.Draw(DC: HDC; X, Y: Integer); begin if Empty then Exit; @@ -54045,9 +53481,7 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TIcon.StretchDraw] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TIcon.StretchDraw(DC: HDC; Dest: TRect); begin if Empty then Exit; @@ -54056,7 +53490,6 @@ begin end; {$ENDIF ASM_VERSION} -//[function TIcon.GetEmpty] function TIcon.GetEmpty: Boolean; begin Result := (fHandle = 0) @@ -54066,8 +53499,6 @@ begin ; end; -//* -//[function TIcon.GetHotSpot] function TIcon.GetHotSpot: TPoint; var II : TIconInfo; begin @@ -54082,8 +53513,6 @@ begin DeleteObject( II.hbmColor ); end; -//* -//[procedure TIcon.LoadFromFile] procedure TIcon.LoadFromFile(const FileName: KOLString); var Strm : PStream; begin @@ -54092,8 +53521,6 @@ begin Strm.Free; end; -//* -//[procedure TIcon.LoadFromStream] procedure TIcon.LoadFromStream(Strm: PStream); var DesiredSize : Integer; Pos : DWord; @@ -54307,18 +53734,14 @@ begin TmpBmp.Free; end; -//[procedure TIcon.SaveToFile] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TIcon.SaveToFile(const FileName: KOLString); begin SaveIcons2File( [ @Self ], FileName ); end; {$ENDIF ASM_VERSION} -//[procedure TIcon.SaveToStream] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TIcon.SaveToStream(Strm: PStream); begin SaveIcons2Stream( [ @Self ], Strm ); @@ -54326,7 +53749,6 @@ end; {$ENDIF ASM_VERSION} {$IFDEF ASM_noVERSION} -//[procedure TIcon.SetHandle] procedure TIcon.SetHandle(const Value: HIcon); const szII = sizeof( TIconInfo ); szBIH = sizeof(TBitmapInfoHeader); @@ -54397,8 +53819,6 @@ begin FHandle := NewHandle; end; -//* -//[procedure TIcon.SetSize] procedure TIcon.SetSize(const Value: Integer); begin {$IFDEF ICON_DIFF_WH} @@ -54422,9 +53842,7 @@ begin end; {$ENDIF} -//[FUNCTION ColorBits] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function ColorBits( ColorsCount : Integer ) : Integer; var I : Integer; begin @@ -54435,9 +53853,7 @@ begin end; end; {$ENDIF ASM_VERSION} -//[END ColorBits] -//[function SaveIcons2StreamEx] function SaveIcons2StreamEx( const BmpHandles: array of HBitmap; Strm: PStream ): Boolean; var I, Off : Integer; IDI : TIconDirEntry; @@ -54613,7 +54029,6 @@ end; {$IFDEF _D2orD3} {$DEFINE _D3orFPC} {$ENDIF} -//[procedure SaveIcons2Stream] procedure SaveIcons2Stream( const Icons : array of PIcon; Strm : PStream ); var I, J, Pos : Integer; {$IFDEF _D3orFPC} @@ -54656,7 +54071,6 @@ begin end; end; -//[procedure SaveIcons2File] procedure SaveIcons2File( const Icons : array of PIcon; const FileName : KOLString ); var Strm: PStream; begin @@ -54665,7 +54079,6 @@ begin Strm.Free; end; -//[procedure TIcon.LoadFromExecutable] procedure TIcon.LoadFromExecutable(const FileName: KOLString; IconIdx: Integer); var I: Integer; begin @@ -54675,33 +54088,27 @@ begin Handle := I; end; -//[function GetFileIconCount] function GetFileIconCount( const FileName: KOLString ): Integer; begin Result := ExtractIcon( hInstance, PKOLChar( FileName ), DWORD(-1) ); end; -//[procedure TIcon.LoadFromResourceID] procedure TIcon.LoadFromResourceID(Inst, ResID, DesiredSize: Integer); begin LoadFromResourceName( Inst, MAKEINTRESOURCE( ResID ), DesiredSize ); end; -//[procedure TIcon.LoadFromResourceName] procedure TIcon.LoadFromResourceName(Inst: Integer; ResName: PKOLChar; DesiredSize: Integer); begin Handle := LoadImage( Inst, ResName, IMAGE_ICON, DesiredSize, DesiredSize, $8000 {LR_SHARED} ); if fHandle <> 0 then FShareIcon := True; end; -//[function LoadImgIcon] function LoadImgIcon( RsrcName: PKOLChar; Size: Integer ): HIcon; begin Result := LoadImage( hInstance, RsrcName, IMAGE_ICON, Size, Size, $8000 {LR_SHARED} ); end; -//* -//[procedure AlignChildrenProc] {$IFDEF OLD_ALIGN} procedure AlignChildrenProc( Sender: PObj ); type @@ -54720,7 +54127,8 @@ var P: PControl; C := P.fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ]; if not C.ToBeVisible then continue; // important: not fVisible, and even not Visible, but ToBeVisible! - if C.fNotUseAlign then continue; + if {$IFDEF USE_FLAGS} G4_NotUseAlign in C.fFlagsG4 + {$ELSE} C.fNotUseAlign {$ENDIF} then continue; if C.FAlign in Allowed then begin R := C.BoundsRect; @@ -54799,15 +54207,21 @@ var CR: TRect; begin if not (oaAligning in P.fAligning) then exit; C := P.fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ]; - with C{-}^{+} do + with C^ do begin {$IFDEF SAFE_CODE} C.RefInc; TRY {$ENDIF} - if (not(fVisible or fCreateHidden)) + if (not( + {$IFDEF USE_FLAGS} (F3_Visible in fStyle.f3_Style) + {$ELSE} fVisible {$ENDIF} + or + {$IFDEF USE_FLAGS} (G4_CreateHidden in fFlagsG4) + {$ELSE} fCreateHidden {$ENDIF} )) or(not(fAlign in Allowed)) then continue; - if not fNotUseAlign then + if {$IFDEF USE_FLAGS} not(G4_NotUseAlign in fFlagsG4) + {$ELSE} not fNotUseAlign {$ENDIF} then begin R := BoundsRect; R1 := R; @@ -54879,13 +54293,21 @@ begin exclude(P.fAligning,oaAligning); end; -{$IFDEF ASM_VERSION} -{$ELSE PAS_VERSION} // Pascal +{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} // Pascal procedure AlignChildrenProc(Sender: PObj); function ToBeAlign( S: PControl ):Boolean; begin - Result := (S.fVisible or S.fCreateHidden) - and(S.isForm or(S.fParent=nil)or ToBeAlign(S.fParent)); + Result := ( + {$IFDEF USE_FLAGS} (F3_Visible in S.fStyle.f3_Style) + {$ELSE} S.fVisible {$ENDIF} + or + {$IFDEF USE_FLAGS} (G3_IsForm in S.fFlagsG3) // так надо! + {$ELSE} S.fCreateHidden {$ENDIF} + ) + and ( {$IFDEF USE_FLAGS} (G3_IsForm in S.fFlagsG3) + {$ELSE} S.fIsForm {$ENDIF} + or (S.fParent=nil) or ToBeAlign(S.fParent) + ); if not Result then include(S.fAligning,oaWaitAlign); end; var fromSelf: Boolean; @@ -54895,7 +54317,9 @@ begin S := Pointer( Sender ); fromSelf := oaFromSelf in S.fAligning; Exclude( S.fAligning, oaFromSelf ); - if ((S.fParent = nil)or(S.isForm)) and (not fromSelf) then + if ( (S.fParent = nil) + or {$IFDEF USE_FLAGS} (G3_IsForm in S.fFlagsG3) + {$ELSE} (S.fIsForm) {$ENDIF} ) and (not fromSelf) then else begin include(S.fAligning, oaWaitAlign); @@ -54903,25 +54327,15 @@ begin end; if ToBeAlign(S) then AlignChildrenProc_(S); - - {if oaFromSelf in PControl(Sender).fAligning then - exclude(PControl(Sender).fAligning,oaFromSelf) - else if(not PControl(Sender).isForm)and(PControl(Sender).fParent<>nil) then begin - include(PControl(Sender).fAligning,oaWaitAlign); - Sender := PControl(Sender).fParent; - end; - if ToBeAlign(PControl(Sender)) then - AlignChildrenProc_(PControl(Sender));} end; {$ENDIF ASM_VERSION} {$ENDIF OLD_ALIGN} -//* -//[procedure TControl.Set_Align] procedure TControl.Set_Align(const Value: TControlAlign); begin Global_Align := AlignChildrenProc; - if fNotUseAlign then Exit; + if {$IFDEF USE_FLAGS} G4_NotUseAlign in fFlagsG4 + {$ELSE} fNotUseAlign {$ENDIF} then Exit; if FAlign = Value then Exit; FAlign := Value; {$IFDEF OLD_ALIGN} @@ -54931,16 +54345,12 @@ begin {$ENDIF} end; -//* -//[function TControl.SetAlign] function TControl.SetAlign(AAlign: TControlAlign): PControl; begin Set_Align( AAlign ); Result := @Self; end; -//* -//[function WndProcPreventResizeFlicks] {$IFDEF LOG_ANTIFLICK} procedure LogFlick( const s: AnsiString; const rects: array of TRect ); var s1: AnsiString; @@ -54958,236 +54368,14 @@ begin end; {$ENDIF} - -function WndProcPreventResizeFlicks( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; -type TRectsArray = array[0..2] of TRect; - PRectsArray = ^TRectsArray; - TChange = ( ChgL, ChgT, ChgR, ChgB ); - TChanges = Set of TChange; -var Rects : PRectsArray; - Changes : Set of TChange; - Resizing : Boolean; - X, Y, DX, DY : Integer; - EntireRect, Src, Dst : TRect; - - function GetClientAfter : TRect; - var R : TRect; - begin - R := Rects[ 2 ]; - OffsetRect( R, Rects[ 0 ].Left - Rects[ 1 ].Left, - Rects[ 0 ].Top - Rects[ 1 ].Top ); - if Rects[ 0 ].Right - Rects[ 0 ].Left <> Rects[ 1 ].Right - Rects[ 1 ].Left then - R.Right := R.Left + (R.Right - R.Left) - + (Rects[ 0 ].Right - Rects[ 0 ].Left) - - (Rects[ 1 ].Right - Rects[ 1 ].Left); - if Rects[ 0 ].Bottom - Rects[ 0 ].Top <> Rects[ 1 ].Bottom - Rects[ 1 ].Top then - R.Bottom := R.Top + (R.Bottom - R.Top) - + (Rects[ 0 ].Bottom - Rects[ 0 ].Top) - - (Rects[ 1 ].Bottom - Rects[ 1 ].Top); - Result := R; - end; - - procedure DoResize( F : PControl; Changes : TChanges ); - var ClientAfter : TRect; - - procedure CollectClipRgn( V : PControl; Changes : TChanges ); - var C : PControl; - I : Integer; - begin - for I := 0 to V.FChildren.FCount - 1 do - begin - C := V.FChildren.{$IFDEF TLIST_FAST} Items {$ELSE} FItems {$ENDIF}[ I ]; - if not C.Visible then Continue; - - if C.fNotUseAlign then - begin - C.Update; - end; - end; - end; // of CollectClipRgn - - begin // DoResize - ClientAfter := GetClientAfter; - CollectClipRgn( F, Changes ); - end; // of DoResize - -var PR: PRect; - R: TRect; -begin // Procedure WndProcResizeFlicks - Result := False; - case Msg.message of - WM_NCCALCSIZE: - if Msg.wParam <> 0 then - begin - Rects := Pointer( Msg.lParam ); - Changes := []; - if Rects[ 0 ].Left <> Rects[ 1 ].Left then - Changes := Changes + [ ChgL ]; - if Rects[ 0 ].Top <> Rects[ 1 ].Top then - Changes := Changes + [ ChgT ]; - if Rects[ 0 ].Right <> Rects[ 1 ].Right then - Changes := Changes + [ ChgR ]; - if Rects[ 0 ].Bottom <> Rects[ 1 ].Bottom then - Changes := Changes + [ ChgB ]; - Resizing := Changes * [ ChgL, ChgT ] <> [ ]; - if Resizing and not Sender.fNotUseAlign then - begin - EntireRect := GetClientAfter; - {$IFDEF LOG_ANTIFLICK} - LogFlick( Sender.Name, [ Rects[0], Rects[1], Rects[2] ] ); - LogFlick( 'ClientAfter', [ EntireRect ] ); - {$ENDIF} - OffsetRect( EntireRect, -EntireRect.Left, -EntireRect.Top ); - if EntireRect.Right - EntireRect.Left < Rects[ 2 ].Right - Rects[ 2 ].Left then - EntireRect.Right := Rects[ 2 ].Right - Rects[ 2 ].Left; - if EntireRect.Bottom - EntireRect.Top < Rects[ 2 ].Bottom - Rects[ 2 ].Top then - EntireRect.Bottom := Rects[ 2 ].Bottom - Rects[ 2 ].Top; - X := Min( Rects[ 0 ].Left, Rects[ 1 ].Left ) + Rects[ 2 ].Left - Rects[ 1 ].Left; - Y := Min( Rects[ 0 ].Top, Rects[ 1 ].Top ) + Rects[ 2 ].Top - Rects[ 2 ].Top; - OffsetRect( EntireRect, X, Y ); - DX := 0; DY := 0; - if ChgL in Changes then - DX := Rects[ 0 ].Left - Rects[ 1 ].Left; - if ChgR in Changes then - DX := Rects[ 0 ].Right - Rects[ 1 ].Right; - if ChgT in Changes then - DY := Rects[ 0 ].Top - Rects[ 1 ].Top; - if ChgB in Changes then - DY := Rects[ 0 ].Bottom - Rects[ 1 ].Bottom; - {$IFDEF LOG_ANTIFLICK} - LogFlick( 'DX=' + Int2Str( DX ) + ', DY=' + Int2Str( DY ), [] ); - {$ENDIF} - DoResize( Sender, Changes ); - Rslt := 0; - if (Changes = [ChgL]) then - begin - Rslt := WVR_VALIDRECTS; - Src := Rects[ 2 ]; - Dst := GetClientAfter; - Src.Right := Src.Left - DX; - Dst.Right := Dst.Left - DX; - end - else - if (Changes = [ChgR]) then - begin - Rslt := WVR_VALIDRECTS; - Src := Rects[ 2 ]; - Dst := GetClientAfter; - Src.Left := Src.Right - DX; - Dst.Left := Dst.Right - DX; - end - else - if (Changes = [ChgT]) then - begin - Rslt := WVR_VALIDRECTS; - Src := Rects[ 2 ]; - Dst := GetClientAfter; - Src.Bottom := Src.Top - DY; - Dst.Bottom := Dst.Top - DY; - end - else - if Changes = [ChgL,ChgT] then - begin - Rslt := WVR_VALIDRECTS; - Src := Rects[ 2 ]; - Dst := GetClientAfter; - Src.Left := Src.Right - DX; - Dst.Left := Dst.Right - DX; - Src.Bottom := Src.Top - DY; - Dst.Bottom := Dst.Top - DY; - end; - if Rslt <> 0 then - begin - Rects[ 1 ] := Src; - Rects[ 2 ] := Dst; - {$IFDEF LOG_ANTIFLICK} - LogFlick( '1:2', [ Rects[1], Rects[2] ] ); - {$ENDIF} - end; - PostMessage( Sender.fHandle, CM_UPDATE, 0, 0 ); - end; - end; - CM_UPDATE: - begin - if Sender.fNotUpdate then - begin - Sender.fNotUpdate := False; - Sender.Invalidate; - end; - Sender.Update; - end; - WM_SIZING: - begin - if (Msg.wParam = WMSZ_TOPLEFT) or (Msg.wParam = WMSZ_BOTTOMLEFT) or (Msg.wParam = WMSZ_TOPRIGHT) then - begin - PR := Pointer( Msg.lParam ); - GetWindowRect( Sender.fHandle, R ); - PostMessage( Sender.fHandle, CM_SIZEPOS, LoWord( PR.Left) or (PR.Top shl 16), - LoWord( PR.Right - PR.Left ) or ( (PR.Bottom - PR.Top) shl 16) ); - if Msg.wParam = WMSZ_TOPLEFT then - if Abs( R.Top - PR.Top ) < Abs( R.Left - PR.Left ) then - PR.Top := R.Top - else - PR.Left := R.Left - else - if Msg.wParam = WMSZ_BOTTOMLEFT then - if Abs( R.Bottom - PR.Bottom ) < Abs( R.Left - PR.Left ) then - PR.Bottom := R.Bottom - else - PR.Left := R.Left - else // WMSZ_TOPRIGHT - if Abs( R.Top - PR.Top ) < Abs( R.Right - PR.Right ) then - PR.Top := R.Top - else - PR.Right := R.Right; - Sender.fNotUpdate := True; - Rslt := 1; - Result := TRUE; - end; - end; - CM_SIZEPOS: - begin - Sender.fNotUpdate := False; - SetWindowPos( Sender.fHandle, 0, SmallInt( LoWord( Msg.wParam ) ), - SmallInt( HiWord( Msg.wParam ) ), SmallInt( LoWord( Msg.lParam ) ), - SmallInt( HiWord( Msg.lParam ) ), SWP_NOZORDER or SWP_NOACTIVATE ); - end; - WM_PAINT: - begin - if Sender.fNotUpdate then - begin - Rslt := 0; - Result := True; - end; - end; - WM_ERASEBKGND: - begin - if Sender.fNotUpdate then - begin - Rslt := 1; - Result := True; - end; - end; - end; -end; - -//* -//[function TControl.PreventResizeFlicks] -function TControl.PreventResizeFlicks: PControl; -begin - fWndProcResizeFlicks := WndProcPreventResizeFlicks; - Result := @Self; -end; - -//* -//[procedure TControl.Update] procedure TControl.Update; var I: Integer; C: PControl; begin if fUpdateCount > 0 then Exit; - if fNotUpdate then Exit; + if {$IFDEF USE_FLAGS} G1_NotUpdate in fFlagsG1 + {$ELSE} fNotUpdate {$ENDIF} then Exit; if fHandle = 0 then Exit; UpdateWindow( fHandle ); for I := 0 to fChildren.fCount - 1 do @@ -55197,9 +54385,7 @@ begin end; end; -//[FUNCTION WndProcUpdate] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function WndProcUpdate( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin if Sender.fUpdateCount <> 0 then @@ -55221,16 +54407,13 @@ begin else Result := FALSE; end; {$ENDIF ASM_VERSION} -//[END WndProcUpdate] -//[procedure TControl.BeginUpdate] procedure TControl.BeginUpdate; begin Inc( fUpdateCount ); AttachProc( @WndProcUpdate ); end; -//[procedure TControl.EndUpdate] procedure TControl.EndUpdate; begin Dec( fUpdateCount ); @@ -55241,8 +54424,6 @@ begin end; end; -//* -//[function TControl.GetSelection] function TControl.GetSelection: KOLString; var L: Integer; begin @@ -55256,15 +54437,11 @@ begin Result := Copy( Text, SelStart + 1, SelLength ); end; -//* -//[procedure TControl.SetSelection] procedure TControl.SetSelection(const Value: KOLString); begin ReplaceSelection( Value, True ); end; -//* -//[procedure TControl.ReplaceSelection] procedure TControl.ReplaceSelection(const Value: KOLString; aCanUndo: Boolean); begin if fCommandActions.aReplaceSel <> 0 then @@ -55273,7 +54450,6 @@ begin end; end; -//[procedure TControl.DeleteLines] procedure TControl.DeleteLines(FromLine, ToLine: Integer); var I1, I2: DWORD; SStart, SLength: DWORD; @@ -55313,9 +54489,7 @@ begin SelLength := Max( 0, SLength ); end; -//* -//[procedure TControl.SetTabOrder] -procedure TControl.SetTabOrder(const Value: Integer); +procedure TControl.SetTabOrder(const Value: SmallInt); var CL: PList; I : Integer; C: PControl; @@ -55332,43 +54506,43 @@ begin CL.Free; end; -//* -//[function TControl.GetFocused] function TControl.GetFocused: Boolean; begin - if fIsControl then - Result := ParentForm.fCurrentControl = @Self + if {$IFDEF USE_FLAGS} G3_IsControl in fFlagsG3 + {$ELSE} fIsControl {$ENDIF} then + Result := ParentForm.DF.fCurrentControl = @Self else - Result := GetForegroundWindow = fHandle; + Result := GetForegroundWindow = fHandle; end; -//* -//[procedure TControl.SetFocused] procedure TControl.SetFocused(const Value: Boolean); var PF: PControl; begin - if not Value or not fTabStop then Exit; - if fIsControl then + if not Value or + {$IFDEF USE_FLAGS} not( F2_Tabstop in fStyle.f2_Style ) + {$ELSE} not fTabStop {$ENDIF} then Exit; + if {$IFDEF USE_FLAGS} G3_IsControl in fFlagsG3 + {$ELSE} fIsControl {$ENDIF} then begin PF := ParentForm; - if Assigned( PF.fCurrentControl ) and (PF.fCurrentControl <> @ Self) then - if Assigned( PF.fCurrentControl.fLeave ) then - PF.fCurrentControl.fLeave( PF.fCurrentControl ) - else - Windows.SetFocus( 0 ); - PF.fCurrentControl := @Self; - if Assigned( fSetFocus ) then - fSetFocus + if ( PF.DF.fCurrentControl <> nil ) and (PF.DF.fCurrentControl <> @ Self) then + if Assigned( PF.DF.fCurrentControl.EV.fLeave ) then + PF.DF.fCurrentControl.EV.fLeave( PF.DF.fCurrentControl ) + else + Windows.SetFocus( 0 ); + PF.DF.fCurrentControl := @Self; + {$IFDEF USE_GRAPHCTLS} + if Assigned( fSetFocus ) then + fSetFocus(@Self) else - SetFocus( GetWindowHandle ); + {$ENDIF} + SetFocus( GetWindowHandle ); end else SetForegroundWindow( GetWindowHandle ); end; {$IFNDEF NOT_USE_RICHEDIT} -type - PCharFormat = ^TCharFormat; ////////////////////////////////////////////////////////////////////// // R I C H E D I T @@ -55376,8 +54550,6 @@ type { -- rich edit -- } -//* -//[function TControl.REGetFont] function TControl.REGetFont: PGraphicTool; var CF: PCharFormat; @@ -55385,213 +54557,192 @@ var //CFW: PCharFormat2W; FS: TFontStyle; begin - CF := @fRECharFormatRec; + CF := @DF.fRECharFormatRec; FillChar( CF^, Sizeof( CF^ ), #0 ); {$IFDEF UNICODE_CTRLS} CF.cbSize := Sizeof( CF^ ); {$ELSE} - CF.cbSize := sizeof( RichEdit.TCharFormat ) + fCharFmtDeltaSz; + CF.cbSize := sizeof( RichEdit.TCharFormat ) + DF.fCharFmtDeltaSz; {$ENDIF} - if fTmpFont = nil then + if DF.fTmpFont = nil then begin - fTmpFont := NewFont; - {$IFDEF USE_AUTOFREE4CONTROLS} - Add2AutoFree( fTmpFont ); - {$ENDIF} + DF.fTmpFont := NewFont; + {$IFDEF USE_AUTOFREE4CONTROLS} + Add2AutoFree( DF.fTmpFont ); + {$ENDIF} end; - Result := fTmpFont; + Result := DF.fTmpFont; Result.OnChange := nil; Perform( EM_GETCHARFORMAT, 1, Integer( CF ) ); Result.FontHeight := CF.yHeight; FS := [ ]; - if LongBool(CF.dwEffects and CFE_BOLD) then - FS := [ fsBold ]; - if LongBool(CF.dwEffects and CFE_ITALIC) then - FS := FS + [ fsItalic ]; - if LongBool(CF.dwEffects and CFE_STRIKEOUT) then - FS := FS + [ fsStrikeOut ]; - if LongBool(CF.dwEffects and CFE_UNDERLINE) then - FS := FS + [ fsUnderline ]; + if LongBool(CF.dwEffects and CFE_BOLD) then + FS := [ fsBold ]; + if LongBool(CF.dwEffects and CFE_ITALIC) then + include( FS, fsItalic ); + if LongBool(CF.dwEffects and CFE_STRIKEOUT) then + include( FS, fsStrikeOut ); + if LongBool(CF.dwEffects and CFE_UNDERLINE) then + include( FS, fsUnderline ); Result.FontStyle := FS; if not LongBool(CF.dwEffects and CFE_AUTOCOLOR) then Result.Color := CF.crTextColor; Result.FontPitch := TFontPitch( CF.bPitchAndFamily and 3 ); Result.FontCharset := CF.bCharSet; - if (PWord( @CF.szFaceName[0] )^ shr 8) = 0 then - Result.FontName := KOLString(PWideChar(@CF.szFaceName[0])) + {$IFDEF UNICODE_CTRLS} + {$ELSE} + if (PWord( @CF.szFaceName[0] )^ shr 8) <> 0 then + Result.FontName := AnsiString(@CF.szFaceName[0]) // real T,0 works fine. else - Result.FontName := AnsiString(@CF.szFaceName[0]); // real T,0 works fine. + {$ENDIF} + Result.FontName := KOLString(PWideChar(@CF.szFaceName[0])); Result.OnChange := RESetFont; end; const RichAreas: array[ TRichFmtArea ] of Integer = ( SCF_SELECTION, 3 {SCF_WORD}, 4 {SCF_ALL} ); -//* -//[procedure TControl.RESetFontEx] procedure TControl.RESetFontEx(const Index: Integer); var CF: PCharFormat; FS: TFontStyle; begin - CF := @fRECharFormatRec; + CF := @DF.fRECharFormatRec; FillChar( CF^, {82} sizeof( CF^ ), #0 ); {$IFDEF UNICODE_CTRLS} CF.cbSize := Sizeof( CF^ ); {$ELSE} - CF.cbSize := 60 { sizeof( TCharFormat ) } + fCharFmtDeltaSz; + CF.cbSize := 60 { sizeof( TCharFormat ) } + DF.fCharFmtDeltaSz; {$ENDIF} CF.dwMask := CFM_BOLD or CFM_COLOR or CFM_FACE or CFM_ITALIC or CFM_SIZE or CFM_STRIKEOUT or CFM_UNDERLINE; - CF.yHeight := fTmpFont.FontHeight; - FS := fTmpFont.FontStyle; + CF.yHeight := DF.fTmpFont.FontHeight; + FS := DF.fTmpFont.FontStyle; if fsBold in FS then CF.dwEffects := CFE_BOLD; if fsItalic in FS then CF.dwEffects := CF.dwEffects or CFE_ITALIC; if fsStrikeOut in FS then CF.dwEffects := CF.dwEffects or CFE_STRIKEOUT; if fsUnderline in FS then CF.dwEffects := CF.dwEffects or CFE_UNDERLINE; - CF.crTextColor := Color2RGB(fTmpFont.Color); - CF.bCharSet := fTmpFont.FontCharset; - CF.bPitchAndFamily := Ord( fTmpFont.FontPitch ); + CF.crTextColor := Color2RGB(DF.fTmpFont.Color); + CF.bCharSet := DF.fTmpFont.FontCharset; + CF.bPitchAndFamily := Ord( DF.fTmpFont.FontPitch ); {$IFDEF UNICODE_CTRLS} WStrLCopy {$ELSE} StrLCopy {$ENDIF} - ( CF.szFaceName, PKOLChar( fTmpFont.FontName ), 31 ); - Perform( EM_SETCHARFORMAT, RichAreas[ fRECharArea ], Integer( CF ) ); + ( CF.szFaceName, PKOLChar( DF.fTmpFont.FontName ), 31 ); + Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( CF ) ); end; -//* -//[procedure TControl.RESetFont] procedure TControl.RESetFont(Value: PGraphicTool); var H: Integer; begin - if Value <> fTmpFont then - REGetFont; - H := fTmpFont.fData.Font.Height; - fTmpFont := fTmpFont.Assign( Value ); - if fTmpFont.fData.Font.Height = 0 then - fTmpFont.fData.Font.Height := H; + if Value <> DF.fTmpFont then + REGetFont; + H := DF.fTmpFont.fData.Font.Height; + DF.fTmpFont := DF.fTmpFont.Assign( Value ); + if DF.fTmpFont.fData.Font.Height = 0 then + DF.fTmpFont.fData.Font.Height := H; RESetFontEx( Integer( CFM_BOLD or CFM_COLOR or CFM_FACE or CFM_ITALIC or CFM_SIZE or CFM_STRIKEOUT or CFM_UNDERLINE ) ); end; -//* -//[function TControl.REGetFontMask] function TControl.REGetFontMask( const Index: Integer ): Boolean; begin REGetFont; - Result := LongBool( fRECharFormatRec.dwMask and Index ); + Result := LongBool( DF.fRECharFormatRec.dwMask and Index ); end; -//* -//[function TControl.REGetFontEffects] function TControl.REGetFontEffects(const Index: Integer): Boolean; begin REGetFont; - Result := LongBool( fRECharFormatRec.dwEffects and Index ); + Result := LongBool( DF.fRECharFormatRec.dwEffects and Index ); end; -//* -//[procedure TControl.RESetFontEffect] procedure TControl.RESetFontEffect(const Index: Integer; const Value: Boolean); var CF: PCharFormat; begin ReGetFont; - CF := @fRECharFormatRec; + CF := @DF.fRECharFormatRec; CF.dwEffects := $FFFFFFFF and Index; if not Value then CF.dwEffects := 0; CF.dwMask := Index; - Perform( EM_SETCHARFORMAT, RichAreas[ fRECharArea ], Integer( CF ) ); + Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( CF ) ); end; -//* -//[function TControl.REGetFontAttr] function TControl.REGetFontAttr(const Index: Integer): Integer; var CF: PDWORD; Mask: DWORD; begin REGetFont; - CF := Pointer( Integer( @fRECharFormatRec ) + (HiWord(Index) and $7E) ); + CF := Pointer( Integer( @DF.fRECharFormatRec ) + (HiWord(Index) and $7E) ); Mask := $FFFFFFFF; if LongBool( HiWord(Index) and $1 ) then Mask := $FF; Result := CF^ and Mask; end; -//* -//[procedure TControl.RESetFontAttr] procedure TControl.RESetFontAttr(const Index, Value: Integer); var CF: PDWORD; Mask: DWORD; begin REGetFont; - CF := Pointer( Integer( @fRECharFormatRec ) + (HiWord(Index) and $7E) ); + CF := Pointer( Integer( @DF.fRECharFormatRec ) + (HiWord(Index) and $7E) ); Mask := 0; if LongBool( HiWord(Index) and $1 ) then Mask := $FFFFFF00; CF^ := CF^ and Mask or DWORD(Value); - fRECharFormatRec.dwMask := Index and $FF81FFFF; - if LongBool( fRECharFormatRec.dwMask and (CFM_COLOR or CFM_BACKCOLOR) ) then - fRECharFormatRec.dwEffects := fRECharFormatRec.dwEffects and + DF.fRECharFormatRec.dwMask := Index and $FF81FFFF; + if LongBool( DF.fRECharFormatRec.dwMask and (CFM_COLOR or CFM_BACKCOLOR) ) then + DF.fRECharFormatRec.dwEffects := DF.fRECharFormatRec.dwEffects and not (CFE_AUTOCOLOR or CFE_AUTOBACKCOLOR); - Perform( EM_SETCHARFORMAT, RichAreas[ fRECharArea ], Integer( @fRECharFormatRec ) ); + Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( @DF.fRECharFormatRec ) ); end; -//[procedure TControl.RESetFontAttr1] procedure TControl.RESetFontAttr1(const Index, Value: Integer); begin RESetFontAttr( Index, Color2RGB( Value ) ); end; -//* -//[function TControl.REGetFontSizeValid] function TControl.REGetFontSizeValid: Boolean; begin Result := REGetFontMask( Integer( CFM_SIZE ) ); end; -//* -//[function TControl.REGetFontName] function TControl.REGetFontName: KOLString; begin ReGetFont; - Result := fRECharFormatRec.szFaceName; + Result := DF.fRECharFormatRec.szFaceName; end; -//* -//[procedure TControl.RESetFontName] procedure TControl.RESetFontName(const Value: KOLString); begin ReGetFont; {$IFDEF UNICODE_CTRLS} WStrLCopy {$ELSE} StrLCopy {$ENDIF} - ( fRECharFormatRec.szFaceName, PKOLChar( Value ), Sizeof( fRECharFormatRec.szFaceName ) - 1 ); - fRECharFormatRec.dwMask := CFM_FACE; - Perform( EM_SETCHARFORMAT, RichAreas[ fRECharArea ], Integer( @fRECharFormatRec ) ); + ( DF.fRECharFormatRec.szFaceName, PKOLChar( Value ), Sizeof( DF.fRECharFormatRec.szFaceName ) - 1 ); + DF.fRECharFormatRec.dwMask := CFM_FACE; + Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( @DF.fRECharFormatRec ) ); end; -//* -//[function TControl.REGetCharformat] function TControl.REGetCharformat: TCharFormat; begin REGetFont; - Result := fRECharFormatRec; + Result := {$IFDEF STATIC_RICHEDIT_DATA} DF.fRECharFormatRec + {$ELSE} DF.fRECharFormatRec^ {$ENDIF}; end; -//* -//[procedure TControl.RESetCharFormat] procedure TControl.RESetCharFormat(const Value: TCharFormat); begin - Perform( EM_SETCHARFORMAT, RichAreas[ fRECharArea ], Integer( @Value ) ); + Perform( EM_SETCHARFORMAT, RichAreas[ DF.fRECharArea ], Integer( @Value ) ); end; -//* -//[function REOut2Stream] function REOut2Stream( Sender: PControl; Buf: PByte; Sz: DWORD; pSz: PInteger ) :DWORD; stdcall; begin - if Sz + Sender.fREStream.Position > Sender.fREStream.Size then - Sender.fREStream.Size := Sender.fREStream.Size + DWORD( {Min(} Sz {, 8192 )} ); - pSz^ := Sender.fREStream.Write( Buf^, Sz ); - if Assigned( Sender.fOnProgress ) then - Sender.fOnProgress( Sender ); + if Sz + Sender.DF.fREStream.Position > Sender.DF.fREStream.Size then + Sender.DF.fREStream.Size := Sender.DF.fREStream.Size + DWORD( {Min(} Sz {, 8192 )} ); + pSz^ := Sender.DF.fREStream.Write( Buf^, Sz ); + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnProgress ) then + {$ENDIF} + Sender.EV.fOnProgress( Sender ); Result := 0; end; @@ -55599,14 +54750,12 @@ const TextTypes: array[ TRETextFormat ] of WORD = ( SF_RTF, SF_TEXT, SF_RTF or SFF_PLAINRTF, SF_RTFNOOBJS, SF_RTFNOOBJS or SFF_PLAINRTF, SF_TEXTIZED, {SF_UNICODE} $0010, $0010 or SF_TEXT ); -//* -//[function TControl.RE_SaveToStream] function TControl.RE_SaveToStream(Stream: PStream; Format: TRETextFormat; SelectionOnly: Boolean): Boolean; var ES: TEditStream; SelFlag: Integer; begin - fREStream := Stream; + DF.fREStream := Stream; ES.dwCookie := Integer( @Self ); ES.dwError := 0; ES.pfnCallback := @REOut2Stream; @@ -55614,20 +54763,17 @@ begin if SelectionOnly then SelFlag := SFF_SELECTION; Perform( EM_STREAMOUT, TextTypes[ Format ] or SelFlag, Integer( @ES ) ); - fREStream := nil; - fREError := ES.dwError; - Result := fREError = 0; + DF.fREStream := nil; + DF.fREError := ES.dwError; + Result := DF.fREError = 0; end; -//[procedure RE_AddText] -procedure RE_AddText( Self_: PControl; const S: AnsiString ); +procedure RE_AddText( Self_: PControl; const S: KOLString ); begin Self_.SelStart := Self_.TextSize; Self_.RE_Text[ reText, True ] := S; end; -//* -//[function TControl.REReadText] function TControl.REReadText(Format: TRETextFormat; SelectionOnly: Boolean): KOLString; var B0: Integer; @@ -55638,37 +54784,38 @@ begin RE_SaveToStream( MS, Format, SelectionOnly ); B0 := 0; MS.Write( B0, Sizeof( KOLChar ) ); - if not (Format in [reUnicode,reTextUnicode]) then - Result := AnsiString(PAnsiChar( MS.fMemory )) // must be PChar, not PKOLChar! + {$IFDEF UNICODE_CTRLS} + {$ELSE} + if not (Format in [reUnicode,reTextUnicode]) then + Result := AnsiString(PAnsiChar( MS.fMemory )) // must be PAnsiChar, not PKOLChar! else - Result := PKOLChar( MS.fMemory ); + {$ENDIF} + Result := PKOLChar( MS.fMemory ); MS.Free; end; -//* -//[function REInFromStream] function REInFromStream( Sender: PControl; Buf: PByte; Sz: DWORD; pSz: PInteger ) :DWORD; stdcall; begin - {$IFDEF _D3} if Sender.fREStrLoadLen >= 0 then {$ENDIF} - if Sz > Sender.fREStrLoadLen then - Sz := Sender.fREStrLoadLen; - pSz^ := Sender.fREStream.Read( Buf^, Sz ); - Dec( Sender.fREStrLoadLen, pSz^ ); - if Assigned( Sender.fOnProgress ) then - Sender.fOnProgress( Sender ); + {$IFDEF _D3} if Sender.DF.fREStrLoadLen >= 0 then {$ENDIF} + if Sz > Sender.DF.fREStrLoadLen then + Sz := Sender.DF.fREStrLoadLen; + pSz^ := Sender.DF.fREStream.Read( Buf^, Sz ); + Dec( Sender.DF.fREStrLoadLen, pSz^ ); + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnProgress ) then + {$ENDIF} + Sender.EV.fOnProgress( Sender ); Result := 0; end; -//* -//[function TControl.RE_LoadFromStream] function TControl.RE_LoadFromStream(Stream: PStream; Length: Integer; Format: TRETextFormat; SelectionOnly: Boolean): Boolean; var ES: TEditStream; SelFlag: Integer; begin - fREStream := Stream; - fREStrLoadLen := DWORD( Length ); + DF.fREStream := Stream; + DF.fREStrLoadLen := DWORD( Length ); ES.dwCookie := Integer( @Self ); ES.dwError := 0; ES.pfnCallback := @REInFromStream; @@ -55676,32 +54823,34 @@ begin if SelectionOnly then SelFlag := SFF_SELECTION; Perform( EM_STREAMIN, TextTypes[ Format ] or SelFlag, Integer( @ES ) ); - fREStream := nil; - fREError := ES.dwError; - Result := fREError = 0; + DF.fREStream := nil; + DF.fREError := ES.dwError; + Result := DF.fREError = 0; end; -//* -//[procedure TControl.REWriteText] procedure TControl.REWriteText(Format: TRETextFormat; SelectionOnly: Boolean; const Value: KOLString); var MS: PStream; + {$IFDEF UNICODE_CTRLS} + {$ELSE} s: AnsiString; // not KOLString! + {$ENDIF} begin fCommandActions.aAddText := RE_AddText; + {$IFDEF UNICODE_CTRLS} + {$ELSE} if not (Format in [reUnicode,reTextUnicode]) then begin s := Value; MS := NewExMemoryStream( @ s[ 1 ], Length( s ) ); end else + {$ENDIF} MS := NewExMemoryStream( @ Value[ 1 ], Length( Value ) * Sizeof( KOLChar ) ); RE_LoadFromStream( MS, MS.fData.fSize, Format, SelectionOnly ); MS.Free; end; -//* -//[function TControl.RE_LoadFromFile] function TControl.RE_LoadFromFile(const Filename: KOLString; Format: TRETextFormat; SelectionOnly: Boolean): Boolean; var Strm: PStream; @@ -55711,8 +54860,6 @@ begin Strm.Free; end; -//* -//[function TControl.RE_SaveToFile] function TControl.RE_SaveToFile(const Filename: KOLString; Format: TRETextFormat; SelectionOnly: Boolean): Boolean; var Strm: PStream; @@ -55722,132 +54869,102 @@ begin Strm.Free; end; -//* -//[function TControl.REGetParaFmt] function TControl.REGetParaFmt: TParaFormat; begin FillChar( Result, sizeof( TParaFormat2 ), #0 ); - Result.cbSize := sizeof( RichEdit.TParaFormat ) + fParaFmtDeltaSz; + Result.cbSize := sizeof( RichEdit.TParaFormat ) + DF.fParaFmtDeltaSz; Perform( EM_GETPARAFORMAT, 0, Integer( @Result ) ); end; -//* -//[procedure TControl.RESetParaFmt] procedure TControl.RESetParaFmt(const Value: TParaFormat); begin - //Value.cbSize := szTParaFmtRec; Perform( EM_SETPARAFORMAT, 0, Integer( @Value ) ); end; -//* -//[function TControl.REGetNumbering] function TControl.REGetNumbering: Boolean; begin Result := LongBool( ReGetParaAttr( 9 shl 16 ) ); end; -//* -//[function TControl.REGetParaAttr] function TControl.REGetParaAttr( const Index: Integer ): Integer; var pDw : PDWORD; begin - fREParaFmtRec := REGetParaFmt; - pDw := Pointer( Integer( @fREParaFmtRec ) + ( HiWord( Index ) and $7E ) ); + {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec + {$ELSE} DF.fREParaFmtRec^ {$ENDIF} + := REGetParaFmt; + pDw := Pointer( Integer( @DF.fREParaFmtRec ) + ( HiWord( Index ) and $7E ) ); Result := pDw^; if LongBool( HiWord( Index ) and 1 ) then Result := Result and $FFFF; end; -//* -//[function TControl.REGetParaAttrValid] function TControl.REGetParaAttrValid( const Index: Integer ): Boolean; begin Result := LongBool( ReGetParaAttr( 4 shl 16 ) and Index ); end; -//* -//[function TControl.REGetTabCount] function TControl.REGetTabCount: Integer; begin Result := ReGetParaAttr( 27 shl 16 ); end; -//* -//[function TControl.REGetTabs] function TControl.REGetTabs(Idx: Integer): Integer; begin Result := ReGetParaAttr( (28 + 4 * Idx) shl 16 ); end; -//* -//[function TControl.REGetTextAlign] function TControl.REGetTextAlign: TRichTextAlign; begin Result := TRichTextAlign( ReGetParaAttr( 25 shl 16 ) - 1 ); end; -//* -//[procedure TControl.RESetNumbering] procedure TControl.RESetNumbering(const Value: Boolean); begin RESetParaAttr( (9 shl 16) or PFM_NUMBERING, Integer( Value ) ); end; -//* -//[procedure TControl.RESetParaAttr] procedure TControl.RESetParaAttr(const Index, Value: Integer); var pDw: PDWORD; Mask: Integer; begin REGetParaAttr( 0 ); - pDw := Pointer( Integer( @fREParaFmtRec ) + ( HiWord( Index ) and $7E ) ); + pDw := Pointer( Integer( @DF.fREParaFmtRec ) + ( HiWord( Index ) and $7E ) ); Mask := 0; if LongBool( HiWord( Index ) and 1 ) then Mask := Integer( $FFFF0000 ); pDw^ := pDw^ and Mask or DWORD(Value); - fREParaFmtRec.dwMask := Index and $8000FFFF; - RESetParaFmt( fREParaFmtRec ); + DF.fREParaFmtRec.dwMask := Index and $8000FFFF; + RESetParaFmt( {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec + {$ELSE} DF.fREParaFmtRec^ {$ENDIF} ); end; -//* -//[procedure TControl.RESetTabCount] procedure TControl.RESetTabCount(const Value: Integer); begin REGetParaAttr( 0 ); RESetParaAttr( (27 shl 16) or PFM_TABSTOPS, Value ); end; -//* -//[procedure TControl.RESetTabs] procedure TControl.RESetTabs(Idx: Integer; const Value: Integer); begin REGetParaAttr( 0 ); RESetParaAttr( (28 + 4 * Idx) or PFM_TABSTOPS, Value ); end; -//* -//[procedure TControl.RESetTextAlign] procedure TControl.RESetTextAlign(const Value: TRichTextAlign); begin RESetParaAttr( (25 shl 16) or PFM_ALIGNMENT, Ord( Value ) + 1 ); end; -//* -//[function TControl.REGetStartIndentValid] function TControl.REGetStartIndentValid: Boolean; begin Result := REGetParaAttrValid( Integer( PFM_STARTINDENT ) ); end; -//* -//[procedure TControl.RE_HideSelection] procedure TControl.RE_HideSelection(aHide: Boolean); begin Perform( EM_HIDESELECTION, Integer( aHide ), 1 ); end; -//* -//[function TControl.RE_SearchText] function TControl.RE_SearchText(const Value: KOLString; MatchCase, WholeWord, ScanForward: Boolean; SearchFrom, SearchTo: Integer): Integer; var Flags: Integer; @@ -55871,7 +54988,6 @@ end; {$IFNDEF _FPC} {$IFNDEF _D2} //------- WideString not supported in D2 -//[function TControl.RE_WSearchText] function TControl.RE_WSearchText(const Value: WideString; MatchCase, WholeWord, ScanForward: Boolean; SearchFrom, SearchTo: Integer): Integer; var Flags: Integer; @@ -55895,44 +55011,32 @@ end; {$ENDIF NOT_USE_RICHEDIT} -//* -//[function TControl.CanUndo] function TControl.CanUndo: Boolean; begin Result := LongBool( Perform( EM_CANUNDO, 0, 0 ) ); end; -//* -//[procedure TControl.EmptyUndoBuffer] procedure TControl.EmptyUndoBuffer; begin Perform( EM_EMPTYUNDOBUFFER, 0, 0 ); end; -//* -//[function TControl.Undo] function TControl.Undo: Boolean; begin Result := LongBool( Perform( EM_UNDO, 0, 0 ) ); end; {$IFNDEF NOT_USE_RICHEDIT} -//* -//[function TControl.RE_Redo] function TControl.RE_Redo: Boolean; begin Result := LongBool( Perform( EM_REDO, 0, 0 ) ); end; -//* -//[function TControl.REGetAutoURLDetect] function TControl.REGetAutoURLDetect: Boolean; begin Result := LongBool( Perform( EM_GETAUTOURLDETECT, 0, 0 ) ); end; -//* -//[procedure TControl.RESetAutoURLDetect] procedure TControl.RESetAutoURLDetect(const Value: Boolean); begin AttachProc( WndProc_RE_LinkNotify ); @@ -55951,15 +55055,11 @@ begin Result := Point2SmallPoint( P ); end; -//* -//[function TControl.GetMaxTextSize] function TControl.GetMaxTextSize: DWORD; begin Result := Perform( EM_GETLIMITTEXT, 0, 0 ); end; -//* -//[procedure TControl.SetMaxTextSize] procedure TControl.SetMaxTextSize(const Value: DWORD); var V1, V2: Integer; begin @@ -55974,8 +55074,6 @@ begin end; end; -//* -//[function WndProc_REFmt] function WndProc_REFmt( _Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Mask: Integer; Shft, Alt, Ctrl, Flg: Boolean; @@ -55990,9 +55088,9 @@ var Mask: Integer; begin Result := False; if Msg.message = WM_CHAR then - if _Self_.FSupressTab then + if _Self_.DF.FSupressTab then begin - _Self_.FSupressTab := FALSE; + _Self_.DF.FSupressTab := FALSE; if Msg.wParam = 9 then begin Result := TRUE; @@ -56007,7 +55105,7 @@ begin Param := Msg.wParam; if Ctrl or Alt and IntIn(Param, [ VK_ADD, VK_SUBTRACT, Integer( '-' ), Integer( '=' ), - Integer( '+' ), 189 {-}, 187 {+} ]) then + Integer( '+' ), 189 , 187 ]) then begin Shft := GetKeyState( VK_SHIFT ) < 0; Rslt := 0; @@ -56146,7 +55244,7 @@ begin Integer('I'): begin Mask := CFM_ITALIC; - _Self_.FSupressTab := TRUE; + _Self_.DF.FSupressTab := TRUE; end; Integer('U'): begin @@ -56185,8 +55283,8 @@ begin else begin Flg := _Self_.REGetFontEffects( Mask ); if not Flg then - _Self_.fRECharFormatRec.dwEffects := _Self_.fRECharFormatRec.dwEffects and not Mask; - _Self_.fRECharFormatRec.dwEffects := _Self_.fRECharFormatRec.dwEffects xor DWORD(Mask); + _Self_.DF.fRECharFormatRec.dwEffects := _Self_.DF.fRECharFormatRec.dwEffects and not Mask; + _Self_.DF.fRECharFormatRec.dwEffects := _Self_.DF.fRECharFormatRec.dwEffects xor DWORD(Mask); end; end else @@ -56201,28 +55299,27 @@ begin begin Mask := Integer( CFM_SIZE ) or Integer( CFM_OFFSET ); Delta := 0; - _Self_.fRECharFormatRec.yOffset := 0; - _Self_.fRECharFormatRec.yHeight := 200; + _Self_.DF.fRECharFormatRec.yOffset := 0; + _Self_.DF.fRECharFormatRec.yHeight := 200; end else if Alt then Mask := Integer( CFM_SIZE ) else Mask := Integer( CFM_OFFSET ); - Inc( _Self_.fRECharFormatRec.yOffset, Delta * _Self_.fRECharFormatRec.yHeight div 3 ); - Inc( _Self_.fRECharFormatRec.yHeight, Delta * _Self_.fRECharFormatRec.yHeight div 8 ); - Flg := LongBool( _Self_.fRECharFormatRec.dwMask and Mask ); + Inc( _Self_.DF.fRECharFormatRec.yOffset, Delta * _Self_.DF.fRECharFormatRec.yHeight div 3 ); + Inc( _Self_.DF.fRECharFormatRec.yHeight, Delta * _Self_.DF.fRECharFormatRec.yHeight div 8 ); + Flg := LongBool( _Self_.DF.fRECharFormatRec.dwMask and Mask ); if not Flg then - _Self_.fRECharFormatRec.yOffset := 0; + _Self_.DF.fRECharFormatRec.yOffset := 0; end; - _Self_.fRECharFormatRec.dwMask := Mask; + _Self_.DF.fRECharFormatRec.dwMask := Mask; if _Self_.SelLength = 0 then _Self_.SelLength := 1; - _Self_.Perform( EM_SETCHARFORMAT, SCF_SELECTION { RichAreas[ _Self_.fRECharArea ] }, Integer( @_Self_.fRECharFormatRec ) ); + _Self_.Perform( EM_SETCHARFORMAT, SCF_SELECTION { RichAreas[ _Self_.fRECharArea ] }, + Integer( @_Self_.DF.fRECharFormatRec ) ); end; end; end; -//* -//[function TControl.RE_FmtStandard] function TControl.RE_FmtStandard: PControl; begin AttachProc( WndProc_REFmt ); @@ -56235,7 +55332,6 @@ begin end; {$ENDIF NOT_USE_RICHEDIT} -//[FUNCTION EnumDynHandlers] {$IFDEF ASM_TLIST} function EnumDynHandlers( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; asm //cmd //opd @@ -56334,7 +55430,6 @@ begin Self_.RefDec; // Destroy Self_, if Free was called for it while processing attached procedures end; {$ENDIF ASM_VERSION} -//[END EnumDynHandlers] procedure TransparentAttachProcExtension ( DynHandlers: PList ); var i: integer; @@ -56352,9 +55447,7 @@ procedure DummyAttachProcExtension ( DynHandlers: PList ); begin end; -//[procedure TControl.AttachProcEx] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal procedure TControl.AttachProcEx( Proc: TWindowFunc; ExecuteAfterAppletTerminated: Boolean ); begin //if fDynHandlers = nil then @@ -56367,18 +55460,15 @@ begin {$IFNDEF SMALLEST_CODE} Global_AttachProcExtension(fDynHandlers); {$ENDIF} - fOnDynHandlers := EnumDynHandlers; + PP.fOnDynHandlers := EnumDynHandlers; end; {$ENDIF ASM_VERSION} -//[procedure TControl.AttachProc] procedure TControl.AttachProc(Proc: TWindowFunc); begin AttachProcEx( Proc, FALSE ); end; -//* -//[procedure TControl.DetachProc] procedure TControl.DetachProc(Proc: TWindowFunc); var I: Integer; begin @@ -56391,20 +55481,15 @@ begin end; end; -//[function TControl.IsProcAttached] -{$IFDEF ASM_VERSION} -{$ELSE ASM_VERSION} //Pascal +{$IFDEF ASM_VERSION}{$ELSE ASM_VERSION} //Pascal function TControl.IsProcAttached(Proc: TWindowFunc): Boolean; var I: Integer; begin - //Result := False; - //if fDynHandlers = nil then Exit; I := fDynHandlers.IndexOf( @Proc ); Result := I >=0; end; {$ENDIF ASM_VERSION} -//[function WndProcAutoPopupMenu] {$IFDEF nASM_VERSION} function WndProcAutoPopupMenu( Control: PControl; var Msg: TMsg; var MsgRslt: Integer ): Boolean; asm @@ -56471,14 +55556,6 @@ asm PUSH ESP // @R PUSH EAX // I JMP @@get_2 - { PUSH EBX // M - PUSH ESI // Control - CALL TControl.Perform - POP EAX - POP ECX - POP ECX - PUSH EAX - JMP @@check_bounds } @@chk_TVM: CMP BX, TVM_GETITEMRECT @@ -56607,7 +55684,6 @@ begin end; {$ENDIF ASM_VERSION} -//[procedure TControl.SetAutoPopupMenu] procedure TControl.SetAutoPopupMenu(PopupMenu: PObj); { new version - by Alexander Pravdin. Allows to attach a submenu (e.g. of the main menu) as a popup menu to a control, to avoid duplicating menu object, @@ -56648,7 +55724,6 @@ begin {$ENDIF} end; -//[function SearchAnsiMnemonics] function SearchAnsiMnemonics( const S: KOLString ): KOLString; var I: Integer; Sh: ShortInt; @@ -56662,14 +55737,12 @@ begin end; end; -//[procedure SupportAnsiMnemonics] procedure SupportAnsiMnemonics( LocaleID: Integer ); begin MnemonicsLocale := LocaleID; SearchMnemonics := SearchAnsiMnemonics; end; -//[function WndProcMnemonics] function WndProcMnemonics( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Form: PControl; @@ -56680,12 +55753,12 @@ var Form: PControl; begin if Msg.message = WM_SYSKEYDOWN then begin - Form.FPressedMnemonic := Msg.wParam; + //Form.DF.fPressedMnemonic := Msg.wParam; C.Perform( WM_LBUTTONDOWN, MK_LBUTTON, XY ); end else begin - Form.FPressedMnemonic := 0; + //Form.DF.fPressedMnemonic := 0; C.Perform( WM_LBUTTONUP, MK_LBUTTON, XY ); end; end; @@ -56695,8 +55768,9 @@ var Form: PControl; for I := 0 to Prnt.ChildCount-1 do begin C := Prnt.Children[ I ]; - if C.IsButton then - if C.Enabled then + if {$IFDEF USE_FLAGS} G5_IsButton in C.fFlagsG5 + {$ELSE} C.IsButton {$ENDIF} then + if C.Enabled then begin if C.fCommandActions.aGetCount = TB_BUTTONCOUNT then for J := 0 to C.Count-1 do @@ -56705,7 +55779,7 @@ var Form: PControl; if pos( KOLString('&') + AnsiChar( Msg.wParam ), SearchMnemonics( C.TBButtonText[ J ] ) ) > 0 then begin C.fCurIndex := J; - C.fCurItem := C.TBIndex2Item( J ); + C.DF.fTBCurItem := C.TBIndex2Item( J ); R := C.TBButtonRect[ J ]; XY := R.Left or (R.Top shl 16); DoPressMnemonic; @@ -56794,28 +55868,28 @@ begin {$ELSE} if (Sender.fAccelTable <> 0) {$IFDEF KEY_PREVIEW} - and (Sender.FKeyPreviewCount = 0) + and (Sender.DF.fKeyPreviewCount = 0) {$ENDIF} then Result := LongBool( TranslateAccelerator( Sender.fHandle, Sender.fAccelTable, Msg ) ); if not Result then begin - if Sender.fCurrentControl <> nil then - if Sender.fCurrentControl.fAccelTable <> 0 then - Result := LongBool( TranslateAccelerator( Sender.fCurrentControl.fHandle, - Sender.fCurrentControl.fAccelTable, Msg ) ); + if Sender.DF.fCurrentControl <> nil then + if Sender.DF.fCurrentControl.fAccelTable <> 0 then + Result := LongBool( TranslateAccelerator( Sender.DF.fCurrentControl.fHandle, + Sender.DF.fCurrentControl.fAccelTable, Msg ) ); end; - if not Result then + if not Result then begin - Form := Sender.ParentForm; - if (Form <> nil) and (Form <> Sender) - {$IFDEF KEY_PREVIEW} - and (Form.FKeyPreviewCount = 0) - {$ENDIF KEY_PREVIEW} - then - if Form.fAccelTable <> 0 then - Result := LongBool( TranslateAccelerator( Form.fHandle, - Form.fAccelTable, Msg ) ); + Form := Sender.ParentForm; + if (Form <> nil) and (Form <> Sender) + {$IFDEF KEY_PREVIEW} + and (Form.DF.fKeyPreviewCount = 0) + {$ENDIF KEY_PREVIEW} + then + if Form.fAccelTable <> 0 then + Result := LongBool( TranslateAccelerator( Form.fHandle, + Form.fAccelTable, Msg ) ); end; {$ENDIF} end; @@ -56846,8 +55920,8 @@ begin begin if Msg.wParam = VK_MENU then begin - if Form.FPressedMnemonic <> 0 then - Form.FPressedMnemonic := Form.FPressedMnemonic or $80000000; + // if Form.DF.fPressedMnemonic <> 0 then + // Form.DF.fPressedMnemonic := Form.DF.fPressedMnemonic or $80000000; end else if AnsiChar( Msg.wParam ) in [ 'A'..'Z', '0'..'9' ] then @@ -56863,29 +55937,22 @@ begin Result := FALSE; end; -//[function TControl.SupportMnemonics] function TControl.SupportMnemonics: PControl; begin fGlobalProcKeybd := WndProcMnemonics; Result := @Self; end; -//* -//[procedure TControl.SelectAll] procedure TControl.SelectAll; begin SelStart := 0; SelLength := -1; // this can be not working for some controls... //*//* end; -{$IFNDEF NOT_USE_RICHEDIT} -//* -//[API RevokeDragDrop] +{$IFnDEF NOT_USE_RICHEDIT} function RevokeDragDrop(wnd: HWnd): HResult; stdcall; external 'ole32.dll' name 'RevokeDragDrop'; -//* -//[function TControl.RE_NoOLEDragDrop] function TControl.RE_NoOLEDragDrop: PControl; begin RevokeDragDrop( Handle ); @@ -56893,52 +55960,53 @@ begin end; {$ENDIF NOT_USE_RICHEDIT} -//* -//[function WndProcOnResize] function WndProcOnResize( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin if Msg.message = WM_SIZE then begin - if Assigned( Self_.fOnResize ) then - Self_.fOnResize( Self_ ); + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnResize ) then + {$ENDIF} + Self_.EV.fOnResize( Self_ ); end; Result := False; end; -//* -//[procedure TControl.SetOnResize] procedure TControl.SetOnResize(const Value: TOnEvent); begin - FOnResize := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .FOnResize := Value; AttachProc( WndProcOnResize ); end; -//[function WndProcMove] function WndProcMove( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin if Msg.message = WM_MOVE then begin - if Assigned( Self_.FOnMove ) then - Self_.FOnMove( Self_ ); + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.FOnMove ) then + {$ENDIF} + Self_.EV.FOnMove( Self_ ); end; Result := False; end; -//[procedure TControl.SetOnMove] procedure TControl.SetOnMove(const Value: TOnEvent); begin - FOnMove := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .FOnMove := Value; AttachProc( WndProcMove ); end; -//[function WndProcMove] function WndProcMoving( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin Result := False; if Msg.message = WM_MOVING then begin - if Assigned( Self_.FOnMoving ) then - Self_.FOnMoving( Self_, Pointer( Msg.lParam ) ); + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.FOnMoving ) then + {$ENDIF} + Self_.EV.FOnMoving( Self_, Pointer( Msg.lParam ) ); Rslt := 1; Result := TRUE; end; @@ -56946,12 +56014,12 @@ end; procedure TControl.SetOnMoving(const Value: TOnEventMoving); begin - FOnMoving := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .FOnMoving := Value; AttachProc( WndProcMoving ); end; {$IFNDEF NOT_USE_RICHEDIT} -//[function WndProc_REBottomless] function WndProc_REBottomless( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin if Msg.message = WM_SIZE then @@ -56959,16 +56027,12 @@ begin Result := False; end; -//* -//[function TControl.RE_Bottomless] function TControl.RE_Bottomless: PControl; begin AttachProc( WndProc_REBottomless ); Result := @Self; end; -//* -//[procedure TControl.RE_Append] procedure TControl.RE_Append(const S: KOLString; ACanUndo: Boolean); begin SelStart := TextSize; @@ -56979,8 +56043,6 @@ begin end; end; -//* -//[procedure TControl.RE_InsertRTF] procedure TControl.RE_InsertRTF(const S: KOLString); var MS: PStream; begin @@ -56992,18 +56054,18 @@ begin end; {$ENDIF NOT_USE_RICHEDIT} -//* -//[procedure TControl.DoSelChange] procedure TControl.DoSelChange; begin - if Assigned( fOnSelChange ) then fOnSelChange( @Self ) + if Assigned( EV.fOnSelChange ) then + EV.fOnSelChange( @Self ) else - if Assigned( fOnChange ) then fOnChange( @Self ); + {$IFDEF NIL_EVENTS} + if Assigned( EV.fOnChange ) then + {$ENDIF} + EV.fOnChange( @Self ); end; {$IFNDEF NOT_USE_RICHEDIT} -//* -//[function TControl.REGetUnderlineEx] function TControl.REGetUnderlineEx: TRichUnderline; begin Result := TRichUnderline( REGetFontAttr( ((81 @@ -57011,8 +56073,6 @@ begin shl 16) or CFM_UNDERLINETYPE ) - 1 ); end; -//* -//[procedure TControl.RESetUnderlineEx] procedure TControl.RESetUnderlineEx(const Value: TRichUnderline); begin RESetFontAttr( ((81 @@ -57021,8 +56081,6 @@ begin RESetFontEffect( CFM_UNDERLINE, True ); end; -//* -//[function TControl.GetTextSize] function TControl.GetTextSize: Integer; begin Result := 0; @@ -57030,8 +56088,6 @@ begin Result := GetWindowTextLength( fHandle ); end; -//* -//[function TControl.REGetTextSize] function TControl.REGetTextSize(Units: TRichTextSize): Integer; const TextLengthFlags: array[ TRichTextSizes ] of Integer = ( not GTL_UseCRLF, not GTL_Precise, GTL_Close, GTL_NUMBytes ); @@ -57044,7 +56100,6 @@ begin Result := Perform( EM_GETTEXTLENGTHEX, Integer( @GTL ), 0 ); end; -//[function TControl.RE_TextSizePrecise] function TControl.RE_TextSizePrecise: Integer; var gtlex : TGetTextLengthEx; begin @@ -57053,190 +56108,159 @@ begin Result := Perform(EM_GETTEXTLENGTHEX,WPARAM(@gtlex), 0 ); end; -//* -//[function TControl.REGetNumStyle] function TControl.REGetNumStyle: TRichNumbering; begin Result := TRichNumbering( ReGetParaAttr( 9 shl 16 ) ); end; -//* -//[procedure TControl.RESetNumStyle] procedure TControl.RESetNumStyle(const Value: TRichNumbering); begin RESetParaAttr( (9 shl 16) or PFM_NUMBERING, Ord( Value ) ); end; -//* -//[function TControl.REGetNumBrackets] function TControl.REGetNumBrackets: TRichNumBrackets; begin REGetParaAttr( 0 ); - Result := TRichNumBrackets( (fREParaFmtRec.wNumberingStyle shr 8) {and 3} ); + Result := TRichNumBrackets( (DF.fREParaFmtRec.wNumberingStyle shr 8) ); end; -//* -//[procedure TControl.RESetNumBrackets] procedure TControl.RESetNumBrackets(const Value: TRichNumBrackets); begin REGetParaAttr( 0 ); - fREParaFmtRec.wNumberingStyle := fREParaFmtRec.wNumberingStyle and $F8FF + DF.fREParaFmtRec.wNumberingStyle := DF.fREParaFmtRec.wNumberingStyle and $F8FF or Word( Ord( Value ) shl 8 ); - fREParaFmtRec.dwMask := PFM_NUMBERINGSTYLE; - RE_ParaFmt := fREParaFmtRec; + DF.fREParaFmtRec.dwMask := PFM_NUMBERINGSTYLE; + RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec + {$ELSE} DF.fREParaFmtRec^ {$ENDIF}; end; -//* -//[function TControl.REGetNumTab] function TControl.REGetNumTab: Integer; begin REGetParaAttr( 0 ); - Result := fREParaFmtRec.wNumberingTab; + Result := DF.fREParaFmtRec.wNumberingTab; end; -//* -//[procedure TControl.RESetNumTab] procedure TControl.RESetNumTab(const Value: Integer); begin REGetParaAttr( 0 ); - fREParaFmtRec.wNumberingTab := Value; - fREParaFmtRec.dwMask := PFM_NUMBERINGTAB; - RE_ParaFmt := fREParaFmtRec; + DF.fREParaFmtRec.wNumberingTab := Value; + DF.fREParaFmtRec.dwMask := PFM_NUMBERINGTAB; + RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec + {$ELSE} DF.fREParaFmtRec^ {$ENDIF}; end; -//* -//[function TControl.REGetNumStart] function TControl.REGetNumStart: Integer; begin REGetParaAttr( 0 ); - Result := fREParaFmtRec.wNumberingStart; + Result := DF.fREParaFmtRec.wNumberingStart; end; -//* -//[procedure TControl.RESetNumStart] procedure TControl.RESetNumStart(const Value: Integer); begin REGetParaAttr( 0 ); - fREParaFmtRec.wNumberingStart := Value; - fREParaFmtRec.dwMask := PFM_NUMBERINGSTART; - RE_ParaFmt := fREParaFmtRec; + DF.fREParaFmtRec.wNumberingStart := Value; + DF.fREParaFmtRec.dwMask := PFM_NUMBERINGSTART; + RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec + {$ELSE} DF.fREParaFmtRec^ {$ENDIF}; end; -//* -//[function TControl.REGetSpacing] function TControl.REGetSpacing( const Index: Integer ): Integer; begin REGetParaAttr( 0 ); - Result := PInteger( Integer(@fREParaFmtRec.dySpaceBefore) + (Index and $F) )^; + Result := PInteger( Integer(@DF.fREParaFmtRec.dySpaceBefore) + (Index and $F) )^; end; -//* -//[procedure TControl.RESetSpacing] procedure TControl.RESetSpacing(const Index, Value: Integer); begin REGetParaAttr( 0 ); - PInteger( Integer(@fREParaFmtRec.dySpaceBefore) + (Index and $F) )^ := Value; - fREParaFmtRec.dwMask := Index and not $F; - RE_ParaFmt := fREParaFmtRec; + PInteger( Integer(@DF.fREParaFmtRec.dySpaceBefore) + (Index and $F) )^ := Value; + DF.fREParaFmtRec.dwMask := Index and not $F; + RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec + {$ELSE} DF.fREParaFmtRec^ {$ENDIF}; end; -//* -//[function TControl.REGetSpacingRule] function TControl.REGetSpacingRule: Integer; begin REGetParaAttr( 0 ); - Result := fREParaFmtRec.bLineSpacingRule; + Result := DF.fREParaFmtRec.bLineSpacingRule; end; -//* -//[procedure TControl.RESetSpacingRule] procedure TControl.RESetSpacingRule(const Value: Integer); begin REGetParaAttr( 0 ); - fREParaFmtRec.bLineSpacingRule := Value; - fREParaFmtRec.dwMask := PFM_LINESPACING; - RE_ParaFmt := fREParaFmtRec; + DF.fREParaFmtRec.bLineSpacingRule := Value; + DF.fREParaFmtRec.dwMask := PFM_LINESPACING; + RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec + {$ELSE} DF.fREParaFmtRec^ {$ENDIF}; end; -//* -//[function TControl.REGetLevel] function TControl.REGetLevel: Integer; begin REGetParaAttr( 0 ); - Result := fREParaFmtRec.bCRC; + Result := DF.fREParaFmtRec.bCRC; end; -//* -//[function TControl.REGetBorder] function TControl.REGetBorder(Side: TBorderEdge; const Index: Integer): Integer; begin REGetParaAttr( 0 ); - Result := PWORD( Integer(@fREParaFmtRec.wBorderSpace) + Index )^ shr (Ord(Side) * 4); + Result := PWORD( Integer(@DF.fREParaFmtRec.wBorderSpace) + Index )^ shr (Ord(Side) * 4); end; -//* -//[procedure TControl.RESetBorder] procedure TControl.RESetBorder(Side: TBorderEdge; const Index: Integer; const Value: Integer); var Mask: Word; pW : PWord; begin REGetParaAttr( 0 ); - pw := PWORD( Integer(@fREParaFmtRec.wBorderSpace) + Index ); + pw := PWORD( Integer(@DF.fREParaFmtRec.wBorderSpace) + Index ); Mask := $F shl (Ord(Side) * 4); pw^ := pw^ and not Mask or (Value shl (4 * Ord(Side)) ); - fREParaFmtRec.dwMask := PFM_BORDER; - RE_ParaFmt := fREParaFmtRec; + DF.fREParaFmtRec.dwMask := PFM_BORDER; + RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec + {$ELSE} DF.fREParaFmtRec^ {$ENDIF}; end; -//* -//[function TControl.REGetParaEffect] function TControl.REGetParaEffect(const Index: Integer): Boolean; begin Result := LongBool( HiWord( REGetParaAttr( 8 shl 16 ) ) and Index ); end; -//* -//[procedure TControl.RESetParaEffect] procedure TControl.RESetParaEffect(const Index: Integer; const Value: Boolean); var Idx: Integer; begin REGetParaAttr( 0 ); - fREParaFmtRec.wReserved := Index; + DF.fREParaFmtRec.wReserved := Index; Idx := Index; //if Idx >= $4000 then Idx := $4000; - fREParaFmtRec.dwMask := Idx shl 16; - RE_ParaFmt := fREParaFmtRec; + DF.fREParaFmtRec.dwMask := Idx shl 16; + RE_ParaFmt := {$IFDEF STATIC_RICHEDIT_DATA} DF.fREParaFmtRec + {$ELSE} DF.fREParaFmtRec^ {$ENDIF}; end; -//* -//[function WndProc_REMonitorIns] function WndProc_REMonitorIns( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin Result := False; if (Msg.message = WM_KEYDOWN) and (Msg.wParam = VK_INSERT) and ((GetKeyState(VK_CONTROL) or GetKeyState(VK_SHIFT) or GetKeyState(VK_MENU)) >= 0) then begin - if not Self_.fReOvrDisable then - Self_.fREOvr := not Self_.fREOvr + if not Self_.DF.fReOvrDisable then + Self_.DF.fREOvr := not Self_.DF.fREOvr else - Result := True; - if assigned( Self_.fOnREInsModeChg ) then - Self_.fOnREInsModeChg( Self_ ); + Result := True; + {$IFDEF NIL_EVENTS} + if assigned( Self_.EV.fOnREInsModeChg ) then + {$ENDIF} + Self_.EV.fOnREInsModeChg( Self_ ); end; end; -//* -//[function TControl.REGetOverwite] function TControl.REGetOverwite: Boolean; begin AttachProc( WndProc_REMonitorIns ); - Result := fREOvr; + Result := DF.fREOvr; end; -//* -//[procedure TControl.RESetOverwrite] procedure TControl.RESetOverwrite(const Value: Boolean); begin if REGetOverwite = Value then // do not replace with fREOvr here! @@ -57245,16 +56269,12 @@ begin Perform( WM_KEYUP, VK_INSERT, 0 ); end; -//* -//[procedure TControl.RESetOvrDisable] procedure TControl.RESetOvrDisable(const Value: Boolean); begin REGetOverwite; - fReOvrDisable := Value; + DF.fReOvrDisable := Value; end; -//* -//[function WndProc_RichEdTransp_ParentPaint] function WndProc_RichEdTransp_ParentPaint( Self_:PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var I: Integer; C: PControl; @@ -57264,135 +56284,128 @@ begin for I := 0 to Self_.fChildren.fCount - 1 do begin C := Self_.fChildren.{$IFDEF TLIST_FAST} Items {$ELSE} fItems {$ENDIF}[ I ]; - if C.fIsCommonControl then + if {$IFDEF USE_FLAGS} G5_IsCommonCtl in C.fFlagsG5 + {$ELSE} C.fIsCommonControl {$ENDIF} then begin - Inc( C.fUpdCount ); - PostMessage( C.fHandle, CM_NCUPDATE, C.fUpdCount, WM_PAINT ); - InvalidateRect( C.fHandle, nil, False ); + Inc( C.DF.fREUpdCount ); + PostMessage( C.fHandle, CM_NCUPDATE, C.DF.fREUpdCount, WM_PAINT ); + InvalidateRect( C.fHandle, nil, False ); end; end; end; Result := False; end; -//* -//[function WndProc_RichEdTransp_Update] function WndProc_RichEdTransp_Update( Self_:PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Rgn, Rgn1: HRgn; R, CR: TRect; Pt: TPoint; VW, HH, VH, HW: Integer; begin - if Self_.fRETransparent then + if Self_.DF.fRETransparent then case Msg.message of WM_CHAR, WM_KILLFOCUS, WM_SETFOCUS, WM_KEYDOWN, WM_LBUTTONDOWN: begin - PostMessage( Self_.fHandle, CM_INVALIDATE, 0, 0 ); + PostMessage( Self_.fHandle, CM_INVALIDATE, 0, 0 ); end; WM_PAINT: - if Msg.wParam = 0 then + if Msg.wParam = 0 then begin - Inc( Self_.fUpdCount ); - PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.fUpdCount, Msg.message ); + Inc( Self_.DF.fREUpdCount ); + PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.DF.fREUpdCount, Msg.message ); end; WM_SIZE: begin - Inc( Self_.fUpdCount ); - PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.fUpdCount, Msg.message ); - PostMessage( Self_.fHandle, CM_INVALIDATE, 0, 0 ); + Inc( Self_.DF.fREUpdCount ); + PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.DF.fREUpdCount, Msg.message ); + PostMessage( Self_.fHandle, CM_INVALIDATE, 0, 0 ); end; WM_ERASEBKGND: - if Msg.wParam = 0 then + if Msg.wParam = 0 then begin - Inc( Self_.fUpdCount ); - PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.fUpdCount, Msg.message ); + Inc( Self_.DF.fREUpdCount ); + PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.DF.fREUpdCount, Msg.message ); end; WM_HSCROLL, WM_VSCROLL: begin - Self_.fREScrolling := LoWord( Msg.wParam ) <> SB_ENDSCROLL; - Inc( Self_.fUpdCount ); - PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.fUpdCount, Msg.message ); - if Self_.fREScrolling then - Self_.Invalidate; + Self_.DF.fREScrolling := LoWord( Msg.wParam ) <> SB_ENDSCROLL; + Inc( Self_.DF.fREUpdCount ); + PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.DF.fREUpdCount, Msg.message ); + if Self_.DF.fREScrolling then + Self_.Invalidate; end; CM_INVALIDATE: begin - //Self_.Update; - Self_.Parent.Invalidate; - Self_.Invalidate; - //Inc( Self_.fUpdCount ); - //PostMessage( Self_.fHandle, CM_NCUPDATE, Self_.fUpdCount, Msg.message ); + Self_.Parent.Invalidate; + Self_.Invalidate; end; CM_NCUPDATE: - if Msg.wParam = Self_.fUpdCount then + if Msg.wParam = Self_.DF.fREUpdCount then begin - //if Msg.lParam = WM_PAINT then - // UpdateWindow( Self_.fHandle ); - GetWindowRect( Self_.fHandle, R ); - Windows.GetClientRect( Self_.fHandle, CR ); - Pt.x := 0; Pt.y := 0; - Pt := Self_.Client2Screen( Pt ); - OffsetRect( CR, Pt.x, Pt.y ); - Rgn := CreateRectRgn( R.Left, R.Top, R.Right, R.Bottom ); - if Self_.fREScrolling then - begin - VW := GetSystemMetrics( SM_CXVSCROLL ); - HH := GetSystemMetrics( SM_CYHSCROLL ); - VH := GetSystemMetrics( SM_CYVSCROLL ); - HW := GetSystemMetrics( SM_CXHSCROLL ); - if CR.Right + VW <= R.Right then + GetWindowRect( Self_.fHandle, R ); + Windows.GetClientRect( Self_.fHandle, CR ); + Pt.x := 0; Pt.y := 0; + Pt := Self_.Client2Screen( Pt ); + OffsetRect( CR, Pt.x, Pt.y ); + Rgn := CreateRectRgn( R.Left, R.Top, R.Right, R.Bottom ); + if Self_.DF.fREScrolling then begin - Rgn1 := CreateRectRgn( CR.Right, CR.Top + VH, CR.Right + VW, CR.Bottom - VH ); - CombineRgn( Rgn, Rgn, Rgn1, RGN_DIFF ); - DeleteObject( Rgn1 ); + VW := GetSystemMetrics( SM_CXVSCROLL ); + HH := GetSystemMetrics( SM_CYHSCROLL ); + VH := GetSystemMetrics( SM_CYVSCROLL ); + HW := GetSystemMetrics( SM_CXHSCROLL ); + if CR.Right + VW <= R.Right then + begin + Rgn1 := CreateRectRgn( CR.Right, CR.Top + VH, CR.Right + VW, CR.Bottom - VH ); + CombineRgn( Rgn, Rgn, Rgn1, RGN_DIFF ); + DeleteObject( Rgn1 ); + end; + if CR.Bottom + HH <= R.Bottom then + begin + Rgn1 := CreateRectRgn( CR.Left + HW, CR.Bottom, CR.Right - HW, CR.Bottom + HH ); + CombineRgn( Rgn, Rgn, Rgn1, RGN_DIFF ); + DeleteObject( Rgn1 ); + end; end; - if CR.Bottom + HH <= R.Bottom then - begin - Rgn1 := CreateRectRgn( CR.Left + HW, CR.Bottom, CR.Right - HW, CR.Bottom + HH ); - CombineRgn( Rgn, Rgn, Rgn1, RGN_DIFF ); - DeleteObject( Rgn1 ); - end; - end; - Self_.Perform( WM_NCPAINT, Rgn, 0 ); - DeleteObject( Rgn ); // Unremarked By M.Gerasimov + Self_.Perform( WM_NCPAINT, Rgn, 0 ); + DeleteObject( Rgn ); // Unremarked By M.Gerasimov end; end; Result := False; end; -//* -//[function TControl.REGetTransparent] function TControl.REGetTransparent: Boolean; begin Result := Longbool(ExStyle and WS_EX_TRANSPARENT); end; -//* -//[procedure TControl.RESetTransparent] procedure TControl.RESetTransparent(const Value: Boolean); begin if Value then ExStyle := ExStyle or WS_EX_TRANSPARENT else ExStyle := ExStyle and not WS_EX_TRANSPARENT; - fRETransparent := Value; + DF.fRETransparent := Value; fParent.AttachProc( WndProc_RichEdTransp_ParentPaint ); AttachProc( WndProc_RichEdTransp_Update ); - fTransparent := Value; + {$IFDEF USE_FLAGS} + if Value then + include( fFlagsG2, G2_Transparent ) + else exclude( fFlagsG2, G2_Transparent ); + {$ELSE} fTransparent := Value; {$ENDIF} end; -//* -//[procedure TControl.RESetOnURL] procedure TControl.RESetOnURL(const Index: Integer; const Value: TOnEvent); begin - if Index = 0 then - fOnREOverURL := Value + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents; {$ENDIF} + if Index = 0 then + EV.fOnREOverURL := Value else - fOnREURLClick := Value; - RE_AutoURLDetect := assigned(fOnREOverURL) or assigned(fOnREURLClick); + EV.fOnREURLClick := Value; + RE_AutoURLDetect := + assigned(EV.fOnREOverURL) or assigned(EV.fOnREURLClick); end; -//[procedure TControl.SetOnRE_URLClick] procedure TControl.SetOnRE_URLClick(const Value: TOnEvent); begin RESetOnURL( 1, Value ); @@ -57403,26 +56416,19 @@ begin RESetOnURL( 0, Value ); end; -{$IFDEF F_P} -//[function TControl.REGetOnURL] function TControl.REGetOnURL(const Index: Integer): TOnEvent; begin CASE Index OF - 0: Result := fOnREOverURL; - else Result := fOnREURLClick; + 0: Result := EV.fOnREOverURL; + else Result := EV.fOnREURLClick; END; end; -{$ENDIF F_P} -//* -//[function TControl.REGetLangOptions] function TControl.REGetLangOptions(const Index: Integer): Boolean; begin Result := LongBool( Perform( EM_GETLANGOPTIONS, 0, 0 ) and Index); end; -//* -//[procedure TControl.RESetLangOptions] procedure TControl.RESetLangOptions(const Index: Integer; const Value: Boolean); var Mask: Integer; @@ -57434,7 +56440,6 @@ begin end; {$ENDIF NOT_USE_RICHEDIT} -//[function DoTrackMouseEvent] function DoTrackMouseEvent(lpEventTrack: PTrackMouseEvent): BOOL; var FunTrack: function(lpEventTrack: PTrackMouseEvent): BOOL; stdcall; ComCtlModule: THandle; @@ -57443,12 +56448,180 @@ begin ComCtlModule := GetModuleHandle( cctrl ); if ComCtlModule = 0 then Exit; FunTrack := GetProcAddress( ComCtlModule, '_TrackMouseEvent' ); - if not Assigned( FunTrack ) then Exit; + if not Assigned( FunTrack ) then Exit; // check is necessary for Win95 ! Result := FunTrack( lpEventTrack ); end; -//* -//[function WndProcMouseEnterLeave] +{$IFDEF ASM_VERSION} +function WndProcMouseEnterLeave( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; +asm + PUSH ESI + XCHG ESI, EAX + + MOV AX, word ptr [EDX].TMsg.message + CMP AX, WM_MOUSELEAVE + JE @@MOUSELEAVE + SUB AX, WM_MOUSEFIRST + CMP AX, WM_MOUSELEAVE-WM_MOUSEFIRST + JA @@retFalse + + {$IFDEF USE_FLAGS} + TEST [ESI].TControl.fFlagsG3, 1 shl G3_MouseInCtl + SETNZ AL + {$ELSE} + MOV AL, [ESI].TControl.fMouseInControl + {$ENDIF} + PUSH EAX + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [ESI].TControl.EV + MOV ECX, [EAX].TEvents.fOnTestMouseOver.TMethod.Code + {$ELSE} + MOV ECX, [ESI].TControl.EV.fOnTestMouseOver.TMethod.Code + {$ENDIF} + JECXZ @@1 + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TEvents.fOnTestMouseOver.TMethod.Data + {$ELSE} + MOV EAX, [ESI].TControl.EV.fOnTestMouseOver.TMethod.Data + {$ENDIF} + MOV EDX, ESI + CALL ECX + JMP @@2 +@@1: + PUSH ECX + PUSH ECX + PUSH ESP + CALL GetCursorPos + MOV EAX, ESI + MOV EDX, ESP + MOV ECX, EDX + CALL TControl.Screen2Client + MOV ECX, ESP // @P + SUB ESP, 16 + MOV EDX, ESP // @ClientRect + MOV EAX, ESI + + PUSH EDX + PUSH ECX + CALL TControl.ClientRect + POP EAX + POP EDX + CALL PointInRect + ADD ESP, 16+8 + +@@2: + POP EDX + CMP AL, DL + JE @@retFalse + + //MouseWasInControl <> Yes + PUSH EAX + MOV EAX, ESI + CALL TControl.Invalidate + POP EAX + + TEST AL, AL + JZ @@3 + + {$IFDEF USE_FLAGS} + OR [ESI].TControl.fFlagsG3, 1 shl G3_MouseInCtl + {$ELSE} + MOV [ESI].TControl.fMouseInControl, 1 + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [ESI].TControl.EV + MOV ECX, [EAX].TEvents.fOnMouseEnter.TMethod.Code + {$ELSE} + MOV ECX, [ESI].TControl.EV.fOnMouseEnter.TMethod.Code + {$ENDIF} + JECXZ @@2_1 + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TEvents.fOnMouseEnter.TMethod.Data + {$ELSE} + MOV EAX, [ESI].TControl.EV.fOnMouseEnter.TMethod.Data + {$ENDIF} + MOV EDX, ESI + CALL ECX +@@2_1: + PUSH ECX + PUSH [ESI].TControl.fHandle + PUSH TME_LEAVE + PUSH 16 + MOV EAX, ESP + CALL DoTrackMouseEvent + JMP @@4 + +@@3: + {$IFDEF USE_FLAGS} + AND byte ptr [ESI].TControl.fFlagsG3, $7F // not(1 shl G3_MouseInCtl) + {$ELSE} + MOV [ESI].TControl.fMouseInControl, 0 + {$ENDIF} + PUSH ECX + PUSH [ESI].TControl.fHandle + PUSH TME_LEAVE or TME_CANCEL + PUSH 16 + MOV EAX, ESP + CALL DoTrackMouseEvent + +@@3_X: + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [ESI].TControl.EV + MOV ECX, [EAX].TEvents.fOnMouseLeave.TMethod.Code + {$ELSE} + MOV ECX, [ESI].TControl.EV.fOnMouseLeave.TMethod.Code + {$ENDIF} + JECXZ @@3_1 + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TEvents.fOnMouseLeave.TMethod.Data + {$ELSE} + MOV EAX, [ESI].TControl.EV.fOnMouseLeave.TMethod.Data + {$ENDIF} + MOV EDX, ESI + CALL ECX +@@3_1: + +@@4: + ADD ESP, 16 + MOV EAX, ESI + CALL TControl.Invalidate + JMP @@retFalse + +@@MOUSELEAVE: + {$IFDEF USE_FLAGS} + BTR dword ptr [ESI].TControl.fFlagsG3, G3_MouseInCtl + JNC @@retFalse + {$ELSE} + BTR DWORD PTR [ESI].TControl.fMouseInControl, 1 + JNC @@retFalse + {$ENDIF} + + {$IFDEF GRAPHCTL_HOTTRACK} + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [ESI].TControl.EV + MOV ECX, [EAX].TEvents.fMouseLeaveProc.TMethod.Code + {$ELSE} + MOV ECX, [ESI].TControl.EV.fMouseLeaveProc.TMethod.Code + {$ENDIF} + {$IFDEF NIL_EVENTS} + JECXZ @@4_1 + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TEvents.fMouseLeaveProc.TMethod.Data + {$ELSE} + MOV EAX, [ESI].TControl.EV.fMouseLeaveProc.TMethod.Data + {$ENDIF} + CALL ECX + {$ENDIF} + + SUB ESP, 16 + JMP @@3_X + +@@retFalse: + XOR EAX, EAX + POP ESI +end; +{$ELSE PASCAL} function WndProcMouseEnterLeave( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var P: TPoint; MouseWasInControl: Boolean; @@ -57458,106 +56631,116 @@ begin case Msg.message of WM_MOUSEFIRST..WM_MOUSELAST: begin - MouseWasInControl := Self_.MouseInControl; - if Assigned( Self_.fOnTestMouseOver ) then - Yes := Self_.fOnTestMouseOver( Self_ ) + MouseWasInControl := {$IFDEF USE_FLAGS} G3_MouseInCtl in Self_.fFlagsG3; + {$ELSE} Self_.fMouseInControl; {$ENDIF} + if Assigned( Self_.EV.fOnTestMouseOver ) then + Yes := Self_.EV.fOnTestMouseOver( Self_ ) else begin - GetCursorPos( P ); - P := Self_.Screen2Client( P ); - Yes := PointInRect( P, Self_.ClientRect ); + GetCursorPos( P ); + P := Self_.Screen2Client( P ); + Yes := PointInRect( P, Self_.ClientRect ); end; - if MouseWasInControl <> Yes then + if MouseWasInControl <> Yes then begin - //??? - Self_.Invalidate; - if Yes then - begin - Self_.fMouseInControl := TRUE; - if Assigned( Self_.fOnMouseEnter ) then - Self_.fOnMouseEnter( Self_ ); - Track.cbSize := Sizeof( Track ); - Track.dwFlags := TME_LEAVE; - Track.hwndTrack := Self_.Handle; - //Track.dwHoverTime := 0; - DoTrackMouseEvent( @ Track ); - //??? - Self_.Invalidate; - end - else - begin - Self_.fMouseInControl := FALSE; - Track.cbSize := Sizeof( Track ); - Track.dwFlags := TME_LEAVE or TME_CANCEL; - Track.hwndTrack := Self_.Handle; - //Track.dwHoverTime := 0; - DoTrackMouseEvent( @ Track ); - if Assigned( Self_.fOnMouseLeave ) then - Self_.fOnMouseLeave( Self_ ); - //??? - Self_.Invalidate; //Erase( FALSE ); - end; + Self_.Invalidate; + if Yes then + begin + {$IFDEF USE_FLAGS} include( Self_.fFlagsG3, G3_MouseInCtl ); + {$ELSE} Self_.fMouseInControl := TRUE; {$ENDIF} + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseEnter ) then + {$ENDIF} + Self_.EV.fOnMouseEnter( Self_ ); + Track.cbSize := Sizeof( Track ); + Track.dwFlags := TME_LEAVE; + Track.hwndTrack := Self_.Handle; + DoTrackMouseEvent( @ Track ); + Self_.Invalidate; + end + else + begin + {$IFDEF USE_FLAGS} exclude( Self_.fFlagsG3, G3_MouseInCtl ); + {$ELSE} Self_.fMouseInControl := FALSE; {$ENDIF} + Track.cbSize := Sizeof( Track ); + Track.dwFlags := TME_LEAVE or TME_CANCEL; + Track.hwndTrack := Self_.Handle; + DoTrackMouseEvent( @ Track ); + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseLeave ) then + {$ENDIF} + Self_.EV.fOnMouseLeave( Self_ ); + Self_.Invalidate; + end; end; end; WM_MOUSELEAVE: begin - if Self_.fMouseInControl then - begin - Self_.fMouseInControl := FALSE; - {$IFDEF GRAPHCTL_HOTTRACK} - if Assigned( Self_.fMouseLeaveProc ) then - Self_.fMouseLeaveProc( Self_ ); - {$ENDIF} - if Assigned( Self_.fOnMouseLeave ) then - Self_.fOnMouseLeave( Self_ ); - //??? - Self_.Invalidate; //Erase( FALSE ); - end; + if {$IFDEF USE_FLAGS} G3_MouseInCtl in Self_.fFlagsG3 + {$ELSE} Self_.fMouseInControl {$ENDIF} then + begin + {$IFDEF USE_FLAGS} exclude( Self_.fFlagsG3, G3_MouseInCtl); + {$ELSE} Self_.fMouseInControl := FALSE; {$ENDIF} + {$IFDEF GRAPHCTL_HOTTRACK} + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fMouseLeaveProc ) then + {$ENDIF} + Self_.EV.fMouseLeaveProc( Self_ ); + {$ENDIF} + {$IFDEF NIL_EVENTS} + if Assigned( Self_.EV.fOnMouseLeave ) then + {$ENDIF} + Self_.EV.fOnMouseLeave( Self_ ); + Self_.Invalidate; //Erase( FALSE ); + end; end; end; Result := False; end; +{$ENDIF ASM_VERSION} -//[procedure ProvideMouseEnterLeave] procedure ProvideMouseEnterLeave( Self_: PControl ); begin InitCommonControls; Self_.AttachProc( WndProcMouseEnterLeave ); - //???Self_.InvalidateErase( FALSE ); end; -//[procedure TControl.SetFlat] procedure TControl.SetFlat(const Value: Boolean); begin - //if fFlat = Value then Exit; + {$IFDEF USE_FLAGS} + if Value then + include( fFlagsG3, G3_Flat ) + else exclude( fFlagsG3, G3_Flat ); + exclude( fFlagsG3, G3_MouseInCtl ); + {$ELSE} fFlat := Value; fMouseInControl := FALSE; + {$ENDIF} ProvideMouseEnterLeave( @Self ); Invalidate; end; -//[procedure TControl.SetOnMouseEnter] procedure TControl.SetOnMouseEnter(const Value: TOnEvent); begin - fOnMouseEnter := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnMouseEnter := Value; ProvideMouseEnterLeave( @Self ); end; -//[procedure TControl.SetOnMouseLeave] procedure TControl.SetOnMouseLeave(const Value: TOnEvent); begin - fOnMouseLeave := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnMouseLeave := Value; ProvideMouseEnterLeave( @Self ); end; -//[procedure TControl.SetOnTestMouseOver] procedure TControl.SetOnTestMouseOver(const Value: TOnTestMouseOver); begin - fOnTestMouseOver := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnTestMouseOver := Value; ProvideMouseEnterLeave( @Self ); end; -//[function WndProcEdTransparent] function WndProcEdTransparent( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin if (Msg.message = WM_KEYDOWN) or @@ -57567,14 +56750,12 @@ begin Result := False; // continue handling of a message anyway end; -//[procedure TControl.EdSetTransparent] procedure TControl.EdSetTransparent(const Value: Boolean); begin Transparent := Value; AttachProc( WndProcEdTransparent ); end; -//[function WndProcSpeedButton] var LastHWnd: HWnd; // + Don function WndProcSpeedButton( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; begin @@ -57595,28 +56776,25 @@ begin end; end; -//[function TControl.LikeSpeedButton] function TControl.LikeSpeedButton: PControl; -//type TProcObj = procedure of object; var Form: PControl; begin AttachProc( WndProcSpeedButton ); - //fSetFocus := TProcObj( MakeMethod( nil, @ DummyObjProc ) ); - fTabstop := False; + {$IFDEF USE_FLAGS} + {$ELSE} fTabstop := False; {$ENDIF} Style := Style and not WS_TABSTOP; Form := ParentForm; if Form <> nil then - if Form.fCurrentControl = @Self then + if Form.DF.fCurrentControl = @Self then begin Form.GotoControl( VK_TAB ); - if Form.fCurrentControl = @Self then - Form.fCurrentControl := nil; + if Form.DF.fCurrentControl = @Self then + Form.DF.fCurrentControl := nil; end; Result := @Self; end; { -- Unicode -- } -//[function TControl.SetUnicode] function TControl.SetUnicode(Unicode: Boolean): PControl; begin Perform( CCM_SETUNICODEFORMAT, Integer( Unicode ), 0 ); @@ -57625,7 +56803,6 @@ end; { -- TabControl -- } -//[function TControl.GetPages] function TControl.GetPages(Idx: Integer): PControl; var Item: TTCItem; begin @@ -57636,7 +56813,6 @@ begin Result := Pointer( Item.lParam ); end; -//[function TControl.TCGetItemText] function TControl.TCGetItemText(Idx: Integer): KOLString; var TI: TTCItem; Buffer: array[ 0..1023 ] of KOLChar; @@ -57649,7 +56825,6 @@ begin Result := PKOLChar( @ Buffer[ 0 ] ); end; -//[procedure TControl.TCSetItemText] procedure TControl.TCSetItemText(Idx: Integer; const Value: KOLString); var TI: TTCItem; begin @@ -57658,7 +56833,6 @@ begin Perform( TCM_SETITEM, Idx, Integer( @TI ) ); end; -//[function TControl.TCGetItemImgIDx] function TControl.TCGetItemImgIDx(Idx: Integer): Integer; var TI: TTCItem; begin @@ -57669,7 +56843,6 @@ begin Result := TI.iImage; end; -//[procedure TControl.TCSetItemImgIdx] procedure TControl.TCSetItemImgIdx(Idx: Integer; const Value: Integer); var TI: TTCItem; begin @@ -57678,7 +56851,6 @@ begin Perform( TCM_SETITEM, Idx, Integer( @TI ) ); end; -//[function TControl.TCGetItemRect] function TControl.TCGetItemRect(Idx: Integer): TRect; begin if Perform( TCM_GETITEMRECT, Idx, Integer( @Result ) ) = 0 then @@ -57690,13 +56862,11 @@ begin end; end; -//[procedure TControl.TC_SetPadding] procedure TControl.TC_SetPadding(cx, cy: Integer); begin Perform( TCM_SETPADDING, 0, cx or (cy shl 16) ); end; -//[function TControl.TC_TabAtPos] function TControl.TC_TabAtPos(x, y: Integer): Integer; type TTCHittestInfo = packed record Pt: TPoint; @@ -57709,20 +56879,17 @@ begin Result := Perform( TCM_HITTEST, 0, Integer( @HTI ) ); end; -//[function TControl.TC_DisplayRect] function TControl.TC_DisplayRect: TRect; begin Windows.GetClientRect( fHandle, Result ); Perform( TCM_ADJUSTRECT, 0, Integer( @Result ) ); end; -//[function TControl.TC_IndexOf] function TControl.TC_IndexOf(const S: KOLString): Integer; begin Result := TC_SearchFor( S, -1, FALSE ); end; -//[function TControl.TC_SearchFor] function TControl.TC_SearchFor(const S: KOLString; StartAfter: Integer; Partial: Boolean): Integer; var I: Integer; @@ -57739,16 +56906,21 @@ begin end; end; -//[function TControl.TC_Insert] function TControl.TC_Insert(Idx: Integer; const TabText: KOLString; TabImgIdx: Integer): PControl; var TI: TTCItem; begin Result := NewPanel( @Self, esNone ); + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:TabPage'; + {$ENDIF} {$IFDEF OLD_ALIGN} Result.FAlign := caClient; //+ Galkov - Result.fNotUseAlign := True; - Result.fVisibleWoParent := TRUE; + {$IFDEF USE_FLAGS} Result.fFlagsG4 := Result.fFlagsG4 + + [G4_VisibleWOParent, G4_NotUseAlign]; + {$ELSE} Result.fVisibleWoParent := TRUE; + Result.fNotUseAlign := True; + {$ENDIF} {$ELSE NEW_ALIGN} Result.Align := caClient; //+ Galkov {$ENDIF} @@ -57764,13 +56936,10 @@ begin Perform(WM_SIZE,0,0); //May be changes of margins for TabControl {$IFDEF GRAPHCTL_XPSTYLES} - Result.fClassicTransparent := Result.fTransparent; - Attach_WM_THEMECHANGED(Result); - XP_Themes_For_TabPanel(Result); + Attach_WM_THEMECHANGED(Result, XP_Themes_For_TabPanel); {$ENDIF} end; -//[procedure TControl.TC_Delete] procedure TControl.TC_Delete(Idx: Integer); var Page: PControl; begin @@ -57782,7 +56951,6 @@ begin end; {$IFNDEF OLD_ALIGN} -//[procedure TControl.TC_InsertControl procedure TControl.TC_InsertControl( Idx: Integer; const TabText: KOLString; TabImgIdx: Integer; Page: PControl); var TI: TTCItem; @@ -57796,7 +56964,6 @@ begin Perform(WM_SIZE,0,0); //May be changes of margins for TabControl end; -//[function TControl.TC_Remove] function TControl.TC_Remove( Idx: Integer ):PControl; begin Result := TC_Pages[ Idx ]; @@ -57808,26 +56975,22 @@ end; { -- TreeView -- } -//[function TControl.TVGetItemIdx] function TControl.TVGetItemIdx(const Index: Integer): THandle; begin Result := Perform( TVM_GETNEXTITEM, Index, 0 ); end; -//[procedure TControl.TVSetItemIdx] procedure TControl.TVSetItemIdx(const Index: Integer; const Value: THandle); begin Perform( TVM_SELECTITEM, Index, Value ); end; -//[function TControl.TVGetItemNext] function TControl.TVGetItemNext(Item: THandle; const Index: Integer): THandle; begin Result := Perform( TVM_GETNEXTITEM, Index, Item ); end; -//[function TControl.TVGetItemRect] function TControl.TVGetItemRect(Item: THandle; TextOnly: Boolean): TRect; begin Result.Left := Item; @@ -57840,7 +57003,6 @@ begin end; end; -//[function TControl.TVGetItemVisible] function TControl.TVGetItemVisible(Item: THandle): Boolean; var R: TRect; begin @@ -57848,14 +57010,12 @@ begin Result := R.Bottom > R.Top; end; -//[procedure TControl.TVSetItemVisible] procedure TControl.TVSetItemVisible(Item: THandle; const Value: Boolean); begin if Value then Perform( TVM_ENSUREVISIBLE, 0, Item ); end; -//[function TControl.TVGetItemStateFlg] function TControl.TVGetItemStateFlg(Item: THandle; const Index: Integer): Boolean; var TVI: TTVItem; begin @@ -57867,7 +57027,6 @@ begin Result := (TVI.state and Index) <> 0; end; -//[procedure TControl.TVSetItemStateFlg] procedure TControl.TVSetItemStateFlg(Item: THandle; const Index: Integer; const Value: Boolean); var TVI: TTVItem; @@ -57881,7 +57040,6 @@ begin Perform( TVM_SETITEM, 0, Integer( @TVI ) ); end; -//[function TControl.TVGetItemImage] function TControl.TVGetItemImage(Item: THandle; const Index: Integer): Integer; var TVI: TTVItem; begin @@ -57905,7 +57063,6 @@ begin end; end; -//[procedure TControl.TVSetItemImage] procedure TControl.TVSetItemImage(Item: THandle; const Index: Integer; const Value: Integer); var TVI: TTVItem; @@ -57923,7 +57080,6 @@ begin Perform( TVM_SETITEM, 0, Integer( @TVI ) ); end; -//[function TControl.TVGetItemText] function TControl.TVGetItemText(Item: THandle): KOLString; var TVI: TTVItem; Buffer: array[ 0..4095 ] of KOLChar; @@ -57937,7 +57093,6 @@ begin Result := PKOLChar( @ Buffer[ 0 ] ); end; -//[procedure TControl.TVSetItemText] procedure TControl.TVSetItemText(Item: THandle; const Value: KOLString); var TVI: TTVItem; begin @@ -57947,7 +57102,6 @@ begin Perform( TVM_SETITEM, 0, Integer( @TVI ) ); end; -//[function TControl.TVItemPath] function TControl.TVItemPath(Item: THandle; Delimiter: KOLChar): KOLString; begin if Item = 0 then @@ -57962,7 +57116,6 @@ begin end; end; -//[function TControl.TV_GetItemHasChildren] function TControl.TV_GetItemHasChildren(Item: THandle): Boolean; var TVI: TTVItem; begin @@ -57972,7 +57125,6 @@ begin Result := TVI.cChildren = 1; end; -//[procedure TControl.TV_GetItemChildCount] function TControl.TV_GetItemChildCount(Item: THandle): Integer; var Node: THandle; begin @@ -57985,7 +57137,6 @@ begin end; end; -//[procedure TControl.TV_SetItemHasChildren] procedure TControl.TV_SetItemHasChildren(Item: THandle; const Value: Boolean); var TVI: TTVItem; @@ -57996,7 +57147,6 @@ begin Perform( TVM_SETITEM, 0, Integer( @TVI ) ); end; -//[function TControl.TVItemAtPos] function TControl.TVItemAtPos(x, y: Integer; var Where: DWORD): THandle; var HTI: TTVHitTestInfo; begin @@ -58018,7 +57168,6 @@ type item: TTVItemEx; end; -//[function TControl.TVInsert] function TControl.TVInsert(nParent, nAfter: THandle; const Txt: KOLString): THandle; var TVIns: TTVInsertStruct; @@ -58032,13 +57181,11 @@ begin Invalidate; end; -//[procedure TControl.TVExpand] procedure TControl.TVExpand(Item: THandle; Flags: DWORD); begin Perform( TVM_EXPAND, Flags, Item ); end; -//[procedure TControl.TVSort] procedure TControl.TVSort( N: THandle ); var a: Cardinal; b: Boolean; @@ -58060,14 +57207,12 @@ begin Perform(TVM_SORTCHILDREN, 0, 0); //+ by YS end; -//[procedure TControl.TVDelete] procedure TControl.TVDelete(Item: THandle); begin Perform( TVM_DELETEITEM, 0, Item ); Invalidate; end; -//[function TControl.TVGetItemData] function TControl.TVGetItemData(Item: THandle): Pointer; var TVI: TTVItem; begin @@ -58078,7 +57223,6 @@ begin Result := Pointer( TVI.lParam ); end; -//[procedure TControl.TVSetItemData] procedure TControl.TVSetItemData(Item: THandle; const Value: Pointer); var TVI: TTVItem; begin @@ -58088,19 +57232,16 @@ begin Perform( TVM_SETITEM, 0, Integer( @TVI ) ); end; -//[procedure TControl.TVEditItem] procedure TControl.TVEditItem(Item: THandle); begin Perform( TVM_EDITLABEL, 0, Item ); end; -//[procedure TControl.TVStopEdit] procedure TControl.TVStopEdit(Cancel: Boolean); begin Perform( TVM_ENDEDITLABELNOW, Integer( Cancel ), 0 ); end; -//[function WndProcTVRightClickSelect] function WndProcTVRightClickSelect( Sender: PControl; var Msg: TMsg; var R: Integer ): Boolean; var I: Integer; Where: DWORD; @@ -58115,18 +57256,17 @@ begin Result := FALSE; end; -//[procedure TControl.SetTVRightClickSelect] procedure TControl.SetTVRightClickSelect(const Value: Boolean); begin - fTVRightClickSelect := Value; + DF.fTVRightClickSelect := Value; if Value then AttachProc( @WndProcTVRightClickSelect ); end; -//[procedure TControl.SetOnTVDelete] procedure TControl.SetOnTVDelete( const Value: TOnTVDelete ); begin - fOnTVDelete := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnTVDelete := Value; if fParent <> nil then begin fParent.Add2AutoFreeEx( Clear ); @@ -58136,7 +57276,6 @@ begin AttachProcEx( ProcTVDeleteItem, TRUE ); end; -//[function ClipboardHasText] function ClipboardHasText: Boolean; begin Result := false; @@ -58148,7 +57287,6 @@ begin end; end; -//[function Clipboard2Text] function Clipboard2Text: AnsiString; var gbl: THandle; str: PAnsiChar; @@ -58173,9 +57311,7 @@ begin end; end; -{-} {$IFNDEF _D2} -//[function Clipboard2WText] function Clipboard2WText: WideString; var gbl: THandle; str: PWideChar; @@ -58201,8 +57337,6 @@ begin end; {$ENDIF} -{+} -//[function Text2Clipboard] function Text2Clipboard( const S: AnsiString ): Boolean; var gbl: THandle; str: PAnsiChar; @@ -58226,9 +57360,7 @@ begin CloseClipboard; end; -{-} {$IFNDEF _D2} -//[function WText2Clipboard] function WText2Clipboard( const WS: WideString ): Boolean; var gbl: THandle; str: PAnsiChar; @@ -58253,8 +57385,6 @@ begin end; {$ENDIF} -{+} -//[function TControl.Size] function TControl.Size(W, H: Integer): PControl; var C, P: PControl; dW, dH: Integer; @@ -58264,7 +57394,7 @@ begin begin dW := 0; dH := 0; P := C.FParent; - if C.ToBeVisible {or C.fCreateHidden {or (P <> nil) and (P.fVisible)} then + if C.ToBeVisible then begin if C.fAlign in [caLeft, caRight, caClient] then begin @@ -58300,7 +57430,6 @@ begin end; {$ENDIF WIN_GDI} -//[procedure AutoSzProc] {$IFDEF GDI} procedure AutoSzProc( Self_: PObj ); var DeltaX, DeltaY: Integer; @@ -58319,7 +57448,7 @@ begin SZ.cy := 0; if Txt <> '' then begin - if Assigned( PControl( Self_ ).fFont ) then + if ( PControl( Self_ ).fFont <> nil ) then if PControl( Self_ ).fFont.fData.Font.Italic then Txt := Txt + ' '; PControl( Self_ ).GetWindowHandle; // this line must be here. @@ -58327,7 +57456,9 @@ begin // it is requested in TCanvas.GetHandle, and in result // of unpredictable recursion some memory can be currupted. PControl( Self_ ).Canvas.TextArea( Txt, SZ, PT ); - if PControl( Self_ ).fWordWrap and (PControl( Self_ ).fAlign <> caClient) then + if {$IFDEF USE_FLAGS} (G1_WordWrap in PControl(Self_).fFlagsG1) + {$ELSE} PControl( Self_ ).fWordWrap {$ENDIF} + and (PControl( Self_ ).fAlign <> caClient) then begin R := PControl( Self_ ).ClientRect; Flags := DT_CALCRECT or DT_EXPANDTABS or DT_WORDBREAK; @@ -58343,17 +57474,18 @@ begin {/-ecm} {+ecm} CtlHavingFont := PControl( Self_ ); - while (CtlHavingFont <> nil) and not Assigned( CtlHavingFont.FFont ) do - CtlHavingFont := CtlHavingFont.Parent; + while (CtlHavingFont <> nil) + and ( CtlHavingFont.FFont = nil ) do + CtlHavingFont := CtlHavingFont.Parent; OldFont := 0; - if Assigned( CtlHavingFont ) then - OldFont := SelectObject( PControl( Self_ ).Canvas.Handle, CtlHavingFont.Font.Handle ); + if ( CtlHavingFont ) <> nil then + OldFont := SelectObject( PControl( Self_ ).Canvas.Handle, CtlHavingFont.Font.Handle ); {/+ecm} // DrawText return the height of the text ! SZ.cy := DrawText( PControl( Self_ ).fCanvas.Handle, PKOLChar( Txt ), Length( Txt ), R, Flags ); {+ecm} - if Assigned( CtlHavingFont ) then - SelectObject(PControl( Self_ ).Canvas.fHandle,OldFont); + if ( CtlHavingFont <> nil ) then + SelectObject(PControl( Self_ ).Canvas.fHandle,OldFont); {/+ecm} SZ.cx := R.Right - R.Left; //SZ.cy := R.Bottom - R.Top; @@ -58362,7 +57494,7 @@ begin Chg := FALSE; if PControl( Self_ ).FAlign in [ caNone, caLeft, caRight ] then begin - DeltaX := PControl( Self_ ).fCommandActions.aAutoSzX; + DeltaX := PControl( Self_ ).aAutoSzX; if PControl( Self_ ).Width <> SZ.cx + DeltaX then begin PControl( Self_ ).Width := SZ.cx + DeltaX; @@ -58376,7 +57508,7 @@ begin end; if PControl( Self_ ).FAlign in [ caNone, caTop, caBottom ] then begin - DeltaY := PControl( Self_ ).fCommandActions.aAutoSzY; + DeltaY := PControl( Self_ ).aAutoSzY; if PControl( Self_ ).Height <> SZ.cy + DeltaY then begin PControl( Self_ ).Height := SZ.cy + DeltaY; @@ -58400,116 +57532,119 @@ end; {$ENDIF GDI} {$IFDEF _X_} {$IFDEF GTK} -procedure AutoSzProc( Self_: PObj ); -var SZ: TSize; +PROCEDURE AutoSzProc( Self_: PObj ); +VAR SZ: TSize; //Txt: KOLString; Chg: Boolean; req_captn, req_evbox: TGtkRequisition; -begin +BEGIN //Txt := PControl( Self_ ).fCaption; SZ.cx := 0; SZ.cy := 0; //if Txt <> '' then - begin - {if Assigned( PControl( Self_ ).fFont ) then - if PControl( Self_ ).fFont.fData.Font.Italic then - Txt := Txt + ' ';} + BEGIN gtk_widget_size_request( PControl( Self_ ).fCaptionHandle, @ req_captn ); - //gtk_widget_get_size_request( PControl( Self_ ).fCaptionHandle, @ Sz.cx, @ Sz.cy ); - //gtk_widget_size_request( PControl( Self_ ).fEventboxHandle, @ requisition2 ); - {if Sz.cx < 0 then Sz.cx := PControl( Self_ ).Width; - if Sz.cy < 0 then Sz.cy := PControl( Self_ ).Height; - Sz.cx := max( requisition2.width, requisition1.width + requisition2.width - Sz.cx ); - Sz.cy := max( requisition2.height, requisition1.height + requisition2.height - Sz.cy );} - if (PControl( Self_ ).fDeltaX = 0) and - (PControl( Self_ ).fDeltaY = 0) then - begin - gtk_widget_size_request( PControl( Self_ ).fEventboxHandle, @ req_evbox ); - PControl( Self_ ).fDeltaX := Max( 0, req_evbox.width - req_captn.width ); - PControl( Self_ ).fDeltaY := Max( 0, req_evbox.height - req_captn.height ); - end; + IF (PControl( Self_ ).fDeltaX = 0) AND + (PControl( Self_ ).fDeltaY = 0) THEN + BEGIN + gtk_widget_size_request( PControl( Self_ ).fEventboxHandle, @ req_evbox ); + PControl( Self_ ).fDeltaX := Max( 0, req_evbox.width - req_captn.width ); + PControl( Self_ ).fDeltaY := Max( 0, req_evbox.height - req_captn.height ); + END; Sz.cx := req_captn.width + PControl( Self_ ).fDeltaX; Sz.cy := req_captn.height + PControl( Self_ ).fDeltaY; //gtk_widget_get_size_request( PControl( Self_ ).fHandle, @ Sz.cx, @ Sz.cy ); - end; + END; Chg := FALSE; - if PControl( Self_ ).FAlign in [ caNone, caLeft, caRight ] then + IF PControl( Self_ ).FAlign in [ caNone, caLeft, caRight ] THEN + BEGIN + //DeltaX := PControl( Self_ ).fCommandActions.aAutoSzX; + if PControl( Self_ ).Width <> SZ.cx {+ DeltaX} then + BEGIN + PControl( Self_ ).Width := SZ.cx {+ DeltaX}; + Chg := TRUE; + END; + IF PControl( Self_ ).fMinWidth > PControl( Self_ ).Width THEN + BEGIN + PControl( Self_ ).Width := PControl( Self_ ).fMinWidth; + Chg := TRUE; + END; + END; + IF PControl( Self_ ).FAlign in [ caNone, caTop, caBottom ] THEN begin - //DeltaX := PControl( Self_ ).fCommandActions.aAutoSzX; - if PControl( Self_ ).Width <> SZ.cx {+ DeltaX} then - begin - PControl( Self_ ).Width := SZ.cx {+ DeltaX}; - Chg := TRUE; - end; - if PControl( Self_ ).fMinWidth > PControl( Self_ ).Width then - begin - PControl( Self_ ).Width := PControl( Self_ ).fMinWidth; - Chg := TRUE; - end; - end; - if PControl( Self_ ).FAlign in [ caNone, caTop, caBottom ] then - begin - //DeltaY := PControl( Self_ ).fCommandActions.aAutoSzY; - if PControl( Self_ ).Height <> SZ.cy {+ DeltaY} then - begin - PControl( Self_ ).Height := SZ.cy {+ DeltaY}; - Chg := TRUE; - end; - if PControl( Self_ ).FMinHeight > PControl( Self_ ).Height then - begin - PControl( Self_ ).Height := PControl( Self_ ).FMinHeight; - Chg := TRUE; - end; - end; - if Chg then - begin - {$IFDEF OLD_ALIGN} - if PControl( Self_ ).fParent <> nil then - Global_Align( PControl( Self_ ).fParent ); - {$ENDIF} - Global_Align( Self_ ); - end; -end; + //DeltaY := PControl( Self_ ).fCommandActions.aAutoSzY; + IF PControl( Self_ ).Height <> SZ.cy {+ DeltaY} THEN + BEGIN + PControl( Self_ ).Height := SZ.cy {+ DeltaY}; + Chg := TRUE; + END; + IF PControl( Self_ ).FMinHeight > PControl( Self_ ).Height THEN + BEGIN + PControl( Self_ ).Height := PControl( Self_ ).FMinHeight; + Chg := TRUE; + END; + END; + IF Chg THEN + BEGIN + {$IFDEF OLD_ALIGN} + if PControl( Self_ ).fParent <> nil then + Global_Align( PControl( Self_ ).fParent ); + {$ENDIF} + Global_Align( Self_ ); + END; +END; {$ENDIF GTK} {$ENDIF _X_} -//[function TControl.AutoSize] function TControl.AutoSize(AutoSzOn: Boolean): PControl; begin if AutoSzOn then begin - fAutoSize := AutoSzProc; + PP.fAutoSize := AutoSzProc; DoAutoSize; end else - fAutoSize := DummyObjProc; + PP.fAutoSize := DummyObjProc; Result := @Self; end; {$IFDEF WIN_GDI} -//[function TControl.IsAutoSize] function TControl.IsAutoSize: Boolean; begin - Result := Assigned( fAutoSize ); + Result := Assigned( PP.fAutoSize ); end; -//* -//[function TControl.GetToBeVisible] +{$IFDEF ASM_VERSION}{$ELSE PASCAL} function TControl.GetToBeVisible: Boolean; begin - Result := fVisible or fCreateHidden or fVisibleWoParent; - if fIsControl then - if Parent <> nil then + Result := {$IFDEF USE_FLAGS} (F3_Visible in fStyle.f3_Style) + {$ELSE} fVisible {$ENDIF} + or {$IFDEF USE_FLAGS} ([G4_CreateHidden, G4_VisibleWOParent] + * fFlagsG4 <> []) + or (G3_IsForm in fFlagsG3) + {$ELSE} fCreateHidden or fVisibleWoParent or IsForm {$ENDIF}; + if {$IFDEF USE_FLAGS} G3_IsControl in fFlagsG3 + {$ELSE} fIsControl {$ENDIF} then + if Parent <> nil then begin - if fVisibleWoParent then - Result := fVisible - else - begin - Parent.Visible; // needed to provide correct fVisible for a form! - Result := Result and Parent.ToBeVisible; - end; + {$IFDEF OLD_ALIGN} + if {$IFDEF USE_FLAGS} G4_VisibleWOParent in fFlagsG4 + {$ELSE} fVisibleWoParent {$ENDIF} then + Result := {$IFDEF USE_FLAGS} F3_Visible in fStyle.f3_Style + {$ELSE} fVisible {$ENDIF} + else + {$ENDIF} + begin + if Result then + begin + Parent.Visible; // needed to provide correct fVisible for a form! + //todo: check if necessary for USE_FLAGS ??? + Result := Parent.ToBeVisible; + end; + end; end; end; +{$ENDIF ASM_VERSION} /////////////////////////////////////////////////////////////////////// // W I N D O W S @@ -58546,7 +57681,6 @@ type TGUIThreadInfo_Proc = function( ThreadID: THandle; var GTI: TGUIThreadInfo var Proc_GetGUIThreadInfo: TGuiThreadInfo_Proc; -//[function GetWindowChild] function GetWindowChild( Wnd: HWnd; Kind: TWindowChildKind ): HWnd; var GTI: TGuiThreadInfo; ThreadID: THandle; @@ -58582,7 +57716,6 @@ begin end; end; -//[function GetFocusedChild] function GetFocusedChild( Wnd: HWnd ): HWnd; var Tr1, Tr2: THandle; begin @@ -58599,7 +57732,6 @@ begin end; end; -//[function WaitFocusedWndChild] function WaitFocusedWndChild( Wnd: HWnd ): HWnd; var T1, T2: Integer; W: HWnd; @@ -58622,7 +57754,6 @@ begin Result := Wnd; end; -//[function Stroke2Window] function Stroke2Window( Wnd: HWnd; const S: AnsiString ): Boolean; var P: PAnsiChar; begin @@ -58639,7 +57770,6 @@ begin Result := True; end; -//[function Stroke2WindowEx] function Stroke2WindowEx( Wnd: HWnd; const S: AnsiString; Wait: Boolean ): Boolean; var P: PAnsiChar; EndChar: AnsiChar; @@ -58869,7 +57999,6 @@ type end; PFindWndRec = ^TFindWndRec; -//[function EnumWindowsProc] function EnumWindowsProc( Wnd : HWnd; Find : PFindWndRec ) : Boolean; stdcall; var Id : DWord; @@ -58883,7 +58012,6 @@ begin end; end; -//[function FindWindowByThreadID] function FindWindowByThreadID( ThreadID : DWORD ) : HWnd; var Find : TFindWndRec; begin @@ -58893,7 +58021,6 @@ begin Result := Find.WndFound; end; -//[function DesktopPixelFormat] function DesktopPixelFormat: TPixelFormat; var DC: HDC; Nbits_per_pixel, Nplanes: Integer; @@ -58928,7 +58055,6 @@ begin Result := TRUE; end;} -//[function GetDesktopRect] function GetDesktopRect : TRect; var W1, W2 : HWnd; begin @@ -58946,20 +58072,18 @@ begin GetWindowRect( W1, Result ); end; -//[function GetWorkArea] function GetWorkArea: TRect; begin SystemParametersInfo( SPI_GETWORKAREA, 0, @ Result, 0 ); end; -//[function ExecuteWait] function ExecuteWait( const AppPath, CmdLine, DfltDirectory: KOLString; Show: DWORD; TimeOut: DWORD; ProcID: PDWORD ): Boolean; var Flags: DWORD; Startup: TStartupInfo; ProcInf: TProcessInformation; DfltDir: PKOLChar; - App: AnsiString; + App: KOLString; begin Result := FALSE; Flags := CREATE_NEW_CONSOLE; @@ -58998,7 +58122,6 @@ begin end; end; -//[function ExecuteIORedirect] function ExecuteIORedirect( const AppPath, CmdLine, DfltDirectory: KOLString; Show: DWORD; ProcID: PDWORD; InPipe, OutPipeWr, OutPipeRd: PHandle ): Boolean; var Flags: DWORD; @@ -59122,14 +58245,13 @@ begin end; end; -//[function ExecuteConsoleAppIORedirect] -function ExecuteConsoleAppIORedirect( const AppPath, CmdLine, DfltDirectory: AnsiString; - Show: DWORD; const InStr: AnsiString; var OutStr: AnsiString; WaitTimeout: DWORD ): Boolean; +function ExecuteConsoleAppIORedirect( const AppPath, CmdLine, DfltDirectory: KOLString; + Show: DWORD; const InStr: KOLString; var OutStr: KOLString; WaitTimeout: DWORD ): Boolean; var PipeIn, PipeOutRd, PipeOutWr: THandle; ProcID: DWORD; BytesCount: DWORD; - Buffer: Array[ 0..4096 ] of AnsiChar; // KOL_ANSI - BufStr: AnsiString; + Buffer: Array[ 0..4096 ] of KOLChar; // KOL_ANSI + BufStr: KOLString; PPipeIn: PHandle; begin Result := FALSE; @@ -59165,13 +58287,11 @@ begin end; {$IFDEF _D2} -//[API OpenProcessToken] function OpenProcessToken(ProcessHandle: THandle; DesiredAccess: DWORD; var TokenHandle: THandle): BOOL; stdcall; external advapi32 name 'OpenProcessToken'; {$ENDIF} -//[function WindowsShutdown] function WindowsShutdown( const Machine : KOLString; Force, Reboot : Boolean ) : Boolean; var hToken: THandle; @@ -59229,7 +58349,6 @@ end; var SaveWinVer: Byte = $FF; -//[function WinVer] {$IFDEF ASM_VERSION} // asm version by MTsv DN (v 2.90) {$ELSE ASM_VERSION} function WinVer : TWindowsVersion; @@ -59280,14 +58399,12 @@ begin end; {$ENDIF ASM_VERSION} -//[function IsWinVer] function IsWinVer( Ver : TWindowsVersions ) : Boolean; {* Returns True if Windows version is in given range of values. } begin Result := WinVer in Ver; end; -//[procedure TControl.SetAlphaBlend] procedure TControl.SetAlphaBlend(const Value: Byte); const LWA_COLORKEY=$00000001; @@ -59312,19 +58429,17 @@ begin 'SetLayeredWindowAttributes' ); if Assigned( SetLayeredWindowAttributes ) then begin - dw := GetWindowLong( GetWindowHandle, GWL_EXSTYLE ); - if Value < 255 then - begin - SetWindowLong( fHandle, GWL_EXSTYLE, dw or WS_EX_LAYERED ); - SetLayeredWindowAttributes( fHandle, 0, Value and $FF, LWA_ALPHA); - end - else - SetWindowLong( fHandle, GWL_EXSTYLE, dw and not WS_EX_LAYERED ); + dw := GetWindowLong( GetWindowHandle, GWL_EXSTYLE ); + if Value < 255 then + begin + SetWindowLong( fHandle, GWL_EXSTYLE, dw or WS_EX_LAYERED ); + SetLayeredWindowAttributes( fHandle, 0, Value {and $FF}, LWA_ALPHA); + end else + SetWindowLong( fHandle, GWL_EXSTYLE, dw and not WS_EX_LAYERED ); end; end; {$ENDIF WIN_GDI} -//[function TControl.SetPosition] function TControl.SetPosition( X, Y: Integer ): PControl; begin Left := X; @@ -59333,22 +58448,20 @@ begin end; {$IFDEF WIN_GDI} -//[function NewColorDialog] function NewColorDialog( FullOpen: TColorCustomOption ): PColorDialog; var I: Integer; begin - {-} New( Result, Create ); - {+}{++}(*Result := PColorDialog.Create;*){--} + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TColorDialog'; + {$ENDIF} Result.ColorCustomOption := FullOpen; for I := 1 to 16 do Result.CustomColors[ I ] := clWhite; end; -//[END NewColorDialog] { TColorDialog } -//[function TColorDialog.Execute] function TColorDialog.Execute: Boolean; var CD: TChooseColor; begin @@ -59367,21 +58480,18 @@ begin Color := CD.rgbResult; end; -//[procedure TControl.SetMaxProgress] procedure TControl.SetMaxProgress(const Index, Value: Integer); begin // ignore index, and set Value via PBM_SETRANGE32: () Perform( PBM_SETRANGE32, 0, Value ); end; -//[procedure TControl.SetDroppedWidth] procedure TControl.SetDroppedWidth(const Value: Integer); begin - FDroppedWidth := Value; + DF.fDroppedWidth := Value; Perform( CB_SETDROPPEDWIDTH, Value, 0 ); end; -//[function TControl.LVGetItemState] function TControl.LVGetItemState(Idx: Integer): TListViewItemState; type PListViewItemState = ^TListViewItemState; @@ -59392,7 +58502,6 @@ begin Result := PListViewItemState( @ I )^; end; -//[procedure TControl.LVSetItemState] procedure TControl.LVSetItemState(Idx: Integer; const Value: TListViewItemState); var Data: TLVItem; begin @@ -59401,13 +58510,11 @@ begin Perform( LVM_SETITEMSTATE, Idx, Integer( @Data ) ); end; -//[procedure TControl.LVSelectAll] procedure TControl.LVSelectAll; begin LVSetItemState( -1, [ lvisSelect ] ); end; -//[function TControl.LVItemInsert] function TControl.LVItemInsert(Idx: Integer; const aText: KOLString): Integer; var LVI: TLVItem; begin @@ -59418,19 +58525,16 @@ begin Result := Perform( LVM_INSERTITEM, 0, Integer( @LVI ) ); end; -//[function TControl.LVItemAdd] function TControl.LVItemAdd(const aText: KOLString): Integer; begin Result := LVItemInsert( Count, aText ); end; -//[function TControl.LVGetSttImgIdx] function TControl.LVGetSttImgIdx(Idx: Integer): Integer; begin Result := Perform( LVM_GETITEMSTATE, Idx, LVIS_STATEIMAGEMASK ) shr 12; end; -//[procedure TControl.LVSetSttImgIdx] procedure TControl.LVSetSttImgIdx(Idx: Integer; const Value: Integer); var LVI: TLVItem; begin @@ -59439,13 +58543,11 @@ begin Perform( LVM_SETITEMSTATE, Idx, Integer( @LVI ) ); end; -//[function TControl.LVGetOvlImgIdx] function TControl.LVGetOvlImgIdx(Idx: Integer): Integer; begin Result := Perform( LVM_GETITEMSTATE, Idx, LVIS_OVERLAYMASK ) shr 8; end; -//[procedure TControl.LVSetOvlImgIdx] procedure TControl.LVSetOvlImgIdx(Idx: Integer; const Value: Integer); var LVI: TLVItem; begin @@ -59454,7 +58556,6 @@ begin Perform( LVM_SETITEMSTATE, Idx, Integer( @LVI ) ); end; -//[function TControl.LVGetItemData] function TControl.LVGetItemData(Idx: Integer): DWORD; var LVI: TLVItem; begin @@ -59465,7 +58566,6 @@ begin Result := LVI.lParam; end; -//[procedure TControl.LVSetItemData] procedure TControl.LVSetItemData(Idx: Integer; const Value: DWORD); var LVI: TLVItem; begin @@ -59476,7 +58576,6 @@ begin Perform( LVM_SETITEM, 0, Integer( @LVI ) ); end; -//[function TControl.LVGetItemIndent] function TControl.LVGetItemIndent(Idx: Integer): Integer; var LI: TLVItem; begin @@ -59487,7 +58586,6 @@ begin Result := LI.iIndent; end; -//[procedure TControl.LVSetItemIndent] procedure TControl.LVSetItemIndent(Idx: Integer; const Value: Integer); var LI: TLVItem; begin @@ -59511,7 +58609,6 @@ type end; PNMLISTVIEW = ^TNMLISTVIEW; -//[function WndProc_LVDeleteItem] function WndProc_LVDeleteItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; var Hdr: PNMHDR; @@ -59526,41 +58623,41 @@ begin LV := Pointer( Hdr ); if Hdr.code = LVN_DELETEITEM then begin - if Assigned( Sender.OnDeleteLVItem ) then - Sender.OnDeleteLVItem( Sender, LV.iItem ); + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnDeleteLVItem ) then + {$ENDIF} + Sender.EV.fOnDeleteLVItem( Sender, LV.iItem ); Result := TRUE; end else if Hdr.code = LVN_DELETEALLITEMS then begin - if Assigned( Sender.OnDeleteAllLVItems ) then - begin - Sender.OnDeleteAllLVItems( Sender ); - Rslt := 0; - if Assigned( Sender.OnDeleteLVItem ) then - Rslt := 1; - end; - Result := TRUE; + if Assigned( Sender.DF.fOnDeleteAllLVItems ) then + begin + Sender.DF.fOnDeleteAllLVItems( Sender ); + Rslt := 0; + if Assigned( Sender.EV.fOnDeleteLVItem ) then + Rslt := 1; + end; + Result := TRUE; end; end; end; end; -//[procedure TControl.SetOnDeleteAllLVItems] procedure TControl.SetOnDeleteAllLVItems(const Value: TOnEvent); begin - fOnDeleteAllLVItems := Value; + DF.fOnDeleteAllLVItems := Value; AttachProc( @WndProc_LVDeleteItem ); end; -//[procedure TControl.SetOnDeleteLVItem] procedure TControl.SetOnDeleteLVItem(const Value: TOnDeleteLVItem); begin - fOnDeleteLVItem := Value; - AttachProc( @WndProc_LVDeleteItem ); + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnDeleteLVItem := Value; + AttachProc( @WndProc_LVDeleteItem ); end; -//[function WndProc_LVData] function WndProc_LVData( Sender: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; var Hdr: PNMHDR; @@ -59588,27 +58685,28 @@ begin Txt := ''; DI.item.iImage := -1; DI.item.state := 0; - Store := FALSE; - if Assigned( LV.OnLVData ) and (DI.item.iItem >= 0) then + if {$IFDEF NIL_EVENTS} Assigned( LV.EV.fOnLVData ) and {$ENDIF} + (DI.item.iItem >= 0) then begin - LV.OnLVData( LV, DI.item.iItem, DI.item.iSubItem, Txt, - DI.item.iImage, DWORD( DI.item.state ), Store ); - LV.fCaption := Txt; - DI.item.pszText := PKOL_Char( PKOLChar( LV.fCaption ) ); - if Store then - DI.item.mask := DI.item.mask or LVIF_DI_SETITEM; - end; - Result := TRUE; + Store := FALSE; + LV.EV.fOnLVData( LV, DI.item.iItem, DI.item.iSubItem, Txt, + DI.item.iImage, DWORD( DI.item.state ), Store ); + LV.fCaption := Txt; + DI.item.pszText := PKOL_Char( PKOLChar( LV.fCaption ) ); + if Store then + DI.item.mask := DI.item.mask or LVIF_DI_SETITEM; + end; + Result := TRUE; end; end; end; end; end; -//[procedure TControl.SetOnLVData] procedure TControl.SetOnLVData(const Value: TOnLVData); begin - fOnLVData := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnLVData := Value; AttachProc( @WndProc_LVData ); Perform( LVM_SETCALLBACKMASK, LVIS_OVERLAYMASK or LVIS_STATEIMAGEMASK, 0 ); end; @@ -59617,7 +58715,6 @@ end; {$DEFINE implementation} {$I KOL_deprecated.inc} {$UNDEF implementation} {$ENDIF DISABLE_DEPRECATED} -//[function WndProc_LVCustomDraw] function WndProc_LVCustomDraw( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var NMCustDraw: PNMLVCustomDraw; @@ -59630,32 +58727,31 @@ begin if Msg.message = WM_NOTIFY then begin NMHdr := Pointer( Msg.lParam ); - if (NMHdr.code = NM_CUSTOMDRAW) and Assigned( Sender.fOnLVCustomDraw ) then + if (NMHdr.code = NM_CUSTOMDRAW) + {$IFDEF NIL_EVENTS} and Assigned( Sender.EV.fOnLVCustomDraw ) {$ENDIF} + then begin NMCustDraw := Pointer( Msg.lParam ); ItemIdx := -1; SubItemIdx := -1; - if LongBool( NMCustDraw.nmcd.dwDrawStage and CDDS_ITEM ) then - ItemIdx := NMCustDraw.nmcd.dwItemSpec; - if LongBool( NMCustDraw.nmcd.dwDrawStage and CDDS_SUBITEM ) then - SubItemIdx := NMCustDraw.iSubItem; + if LongBool( NMCustDraw.nmcd.dwDrawStage and CDDS_ITEM ) then + ItemIdx := NMCustDraw.nmcd.dwItemSpec; + if LongBool( NMCustDraw.nmcd.dwDrawStage and CDDS_SUBITEM ) then + SubItemIdx := NMCustDraw.iSubItem; ItemState := [ ]; - if ItemIdx >= 0 then + if ItemIdx >= 0 then begin - S := Sender.LVItemState[ ItemIdx ]; - if lvisFocus in S then - ItemState := ItemState + [ odsFocused ]; - if lvisSelect in S then - ItemState := ItemState + [ odsSelected ]; - if lvisBlend in S then - ItemState := ItemState + [ odsGrayed ]; - if lvisHighlight in S then - ItemState := ItemState + [ odsMarked ]; + S := Sender.LVItemState[ ItemIdx ]; + if lvisFocus in S then + include( ItemState, odsFocused ); + if lvisSelect in S then + include( ItemState, odsSelected ); + if lvisBlend in S then + include( ItemState, odsGrayed ); + if lvisHighlight in S then + include( ItemState, odsMarked ); end; - - //Sender.Canvas; //???????????????????????????? - - Rslt := Sender.FOnLVCustomDraw( Sender, {Sender.fPaintDC} NMCustDraw.nmcd.hdc, + Rslt := Sender.EV.FOnLVCustomDraw( Sender, {Sender.fPaintDC} NMCustDraw.nmcd.hdc, NMCustDraw.nmcd.dwDrawStage, ItemIdx, SubItemIdx, NMCustDraw.nmcd.rc, ItemState, TColor( NMCustDraw.clrText ), TColor( NMCustDraw.clrTextBk ) ); @@ -59664,44 +58760,47 @@ begin end; end; -//[procedure TControl.SetOnLVCustomDraw] procedure TControl.SetOnLVCustomDraw(const Value: TOnLVCustomDraw); begin - fOnLVCustomDraw := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnLVCustomDraw := Value; AttachProc( @WndProc_LVCustomDraw ); end; -//[function CompareLVItems] function CompareLVItems( Idx1, Idx2: Integer; ListView: PControl ): Integer; stdcall; begin - if Assigned( ListView.fOnCompareLVItems ) then - Result := ListView.fOnCompareLVItems( ListView, Idx1, Idx2 ) + {$IFDEF NIL_EVENTS} + if Assigned( ListView.EV.fOnCompareLVItems ) then + {$ENDIF} + Result := ListView.EV.fOnCompareLVItems( ListView, Idx1, Idx2 ) + {$IFDEF NIL_EVENTS} else - Result := 0; + Result := 0 + {$ENDIF} ; end; -//[procedure TControl.LVSort] procedure TControl.LVSort; begin Perform( LVM_SORTITEMSEX, Integer(@Self), Integer(@CompareLVItems) ); end; -//[function CompareLVItemsData] function CompareLVItemsData( D1, D2: DWORD; ListView: PControl ): Integer; stdcall; begin - if Assigned( ListView.fOnCompareLVItems ) then - Result := ListView.fOnCompareLVItems( ListView, D1, D2 ) + {$IFDEF NIL_EVENTS} + if Assigned( ListView.EV.fOnCompareLVItems ) then + {$ENDIF} + Result := ListView.EV.fOnCompareLVItems( ListView, D1, D2 ) + {$IFDEF NIL_EVENTS} else - Result := 0; + Result := 0 + {$ENDIF} ; end; -//[procedure TControl.LVSortData] procedure TControl.LVSortData; begin Perform( LVM_SORTITEMS, Integer( @Self ), Integer( @CompareLVItemsData ) ); end; -//[function WndProc_LVColumnClick] function WndProc_LVColumnClick( Sender: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; var Hdr: PNMHDR; @@ -59716,22 +58815,23 @@ begin LV := Pointer( Hdr ); if Hdr.code = LVN_COLUMNCLICK then begin - if Assigned( Sender.OnColumnClick ) then - Sender.OnColumnClick( Sender, LV.iSubItem ); + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnColumnClick ) then + {$ENDIF} + Sender.EV.fOnColumnClick( Sender, LV.iSubItem ); Result := TRUE; end; end; end; end; -//[procedure TControl.SetOnColumnClick] procedure TControl.SetOnColumnClick(const Value: TOnLVColumnClick); begin - fOnColumnClick := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnColumnClick := Value; AttachProc( @WndProc_LVColumnClick ); end; -//[function WndProc_LVStateChange] function WndProc_LVStateChange( Sender: PControl; var Msg: TMsg; var R: Integer ): Boolean; var NMOD: PNMLVODStateChange; NMLV: PNMLISTVIEW; @@ -59742,58 +58842,58 @@ begin NMLV := Pointer( Msg.lParam ); if NMOD.hdr.code = LVN_ODSTATECHANGED then begin - if Assigned( Sender.OnLVStateChange ) then - Sender.OnLVStateChange( Sender, NMOD.iFrom, NMOD.iTo, - NMOD.uOldState, NMOD.uNewState ); + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnLVStateChange ) then + {$ENDIF} + Sender.EV.fOnLVStateChange( Sender, NMOD.iFrom, NMOD.iTo, + NMOD.uOldState, NMOD.uNewState ); end else if NMLV.hdr.code = LVN_ITEMCHANGED then begin - if Assigned( Sender.OnLVStateChange ) then - Sender.OnLVStateChange( Sender, NMLV.iItem, NMLV.iItem, - NMLV.uOldState, NMLV.uNewState ); + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnLVStateChange ) then + {$ENDIF} + Sender.EV.fOnLVStateChange( Sender, NMLV.iItem, NMLV.iItem, + NMLV.uOldState, NMLV.uNewState ); end; end; Result := FALSE; end; -//[procedure TControl.SetOnLVStateChange] procedure TControl.SetOnLVStateChange(const Value: TOnLVStateChange); begin - FOnLVStateChange := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .FOnLVStateChange := Value; AttachProc( WndProc_LVStateChange ); end; -//[function CompareLVColumns] function CompareLVColumns( Idx1, Idx2: Integer; Sender: PControl ): Integer; stdcall; var S1, S2: KOLString; begin //--- changed by Mike Gerasimov: - S1 := Sender.LVItems[ Idx1, Sender.fColumn ]; - S2 := Sender.LVItems[ Idx2, Sender.fColumn ]; - If lvoSortAscending in Sender.fLVOptions Then - Result := AnsiCompareStrNoCase( S1, S2 ) + S1 := Sender.LVItems[ Idx1, Sender.DF.fColumn ]; + S2 := Sender.LVItems[ Idx2, Sender.DF.fColumn ]; + If lvoSortAscending in Sender.DF.fLVOptions Then + Result := AnsiCompareStrNoCase( S1, S2 ) Else - If lvoSortDescending in Sender.fLVOptions Then - Result := AnsiCompareStrNoCase( S2, S1 ) - Else - Result:=0; + If lvoSortDescending in Sender.DF.fLVOptions Then + Result := AnsiCompareStrNoCase( S2, S1 ) + Else + Result:=0; end; -//[procedure TControl.LVSortColumn] procedure TControl.LVSortColumn(Idx: Integer); begin - fColumn := Idx; + DF.fColumn := Idx; Perform( LVM_SORTITEMSEX, Integer(@Self), Integer(@CompareLVColumns) ); end; -//[function TControl.LVIndexOf] function TControl.LVIndexOf(const S: KOLString): Integer; begin Result := LVSearchFor( S, -1, FALSE ); end; -//[function TControl.LVSearchFor] function TControl.LVSearchFor(const S: KOLString; StartAfter: Integer; Partial: Boolean): Integer; var f: TLVFindInfo; @@ -59841,7 +58941,7 @@ function WndProcLVMeasureItem2( Sender: PControl; var Msg: TMsg; var Rslt: Integ begin Result := FALSE; if (Msg.message = WM_MEASUREITEM) and (Msg.wParam = 0) then begin - Rslt := Sender.fLVItemHeight; + Rslt := Sender.DF.fLVItemHeight; Result := TRUE; end; @@ -59855,22 +58955,22 @@ end; procedure TControl.Set_LVItemHeight(Value: Integer); begin - if fLVItemHeight <> Value then begin - if fLVItemHeight = 0 then begin - Parent.AttachProc(WndProcLVMeasureItem); - AttachProc(WndProcLVMeasureItem2); - end; - fLVItemHeight := Value; + if DF.fLVItemHeight <> Value then + begin + if DF.fLVItemHeight = 0 then + begin + Parent.AttachProc(WndProcLVMeasureItem); + AttachProc(WndProcLVMeasureItem2); + end; + DF.fLVItemHeight := Value; end; end; -//[function TControl.IndexOf] function TControl.IndexOf(const S: KOLString): Integer; begin Result := SearchFor( S, -1, FALSE ); end; -//[function TControl.SearchFor] function TControl.SearchFor(const S: KOLString; StartAfter: Integer; Partial: Boolean): Integer; var Cmd: Integer; @@ -59896,95 +58996,112 @@ begin end; end; -//[function TControl.DefaultBtnProc] function TControl.DefaultBtnProc(var Msg: TMsg; var Rslt: Integer): Boolean; var Btn: PControl; - F: PControl; + F, dfltBtn, cnclBtn: PControl; begin - if Assigned( fOldOnMessage ) then + {$IFDEF NIL_EVENTS} + if Assigned( EV.fOldOnMessage ) then + {$ENDIF} begin - Result := fOldOnMessage( Msg, Rslt ); - if Result then Exit; + Result := EV.fOldOnMessage( Msg, Rslt ); + if Result then Exit; end; Result := FALSE; if AppletTerminated then Exit; F := Applet; - if not F.fIsForm then - begin - F := F.fCurrentControl; - if F = nil then Exit; - end; + if {$IFDEF USE_FLAGS} not(G3_IsForm in F.fFlagsG3) + {$ELSE} not F.fIsForm {$ENDIF} then + F := F.DF.fCurrentControl; + if F = nil then Exit; Btn := nil; - if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and - ((Msg.wParam = VK_RETURN) or (Msg.wParam = VK_ESCAPE)) then + if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and + ((Msg.wParam = VK_RETURN) or (Msg.wParam = VK_ESCAPE)) then begin - if (Msg.wParam = VK_RETURN) and - (F.fDefaultBtnCtl <> nil) and - F.fDefaultBtnCtl.ToBeVisible and - F.fDefaultBtnCtl.Enabled and - ((F.fCurrentControl=nil) or (not F.fCurrentControl.fCancelBtn and - not F.fCurrentControl.fIgnoreDefault) - or (F.fCurrentControl = F.fDefaultBtnCtl) - ) then - Btn := F.fDefaultBtnCtl + dfltBtn := Pointer( F.PropInt[ @DFLT_BTN ] ); // .DF.fDefaultBtnCtl; + cnclBtn := Pointer( F.PropInt[ @CNCL_BTN ] ); //.DF.fCancelBtnCtl; + if (Msg.wParam = VK_RETURN) and + (dfltBtn <> nil) and + dfltBtn.ToBeVisible and + dfltBtn.Enabled and + ( (F.DF.fCurrentControl=nil) or + ({$IFDEF USE_FLAGS} not(G6_CancelBtn in F.DF.fCurrentControl.fFlagsG6) + {$ELSE} not F.DF.fCurrentControl.fCancelBtn {$ENDIF} and + {$IFDEF USE_FLAGS} not(G5_IgnoreDefault in F.DF.fCurrentControl.fFlagsG5) + {$ELSE} not F.DF.fCurrentControl.fIgnoreDefault {$ENDIF}) + or (F.DF.fCurrentControl = dfltBtn) + ) then + Btn := dfltBtn else - if (Msg.wParam = VK_ESCAPE) and - (F.fCancelBtnCtl <> nil) and - F.fCancelBtnCtl.ToBeVisible and - F.fCancelBtnCtl.Enabled then - Btn := F.fCancelBtnCtl + if (Msg.wParam = VK_ESCAPE) and + (cnclBtn <> nil) and + cnclBtn.ToBeVisible and + cnclBtn.Enabled then + Btn := cnclBtn else - if (Msg.wParam = VK_RETURN) and - (F.fAllBtnReturnClick or fAllBtnReturnClick) and - (F.ActiveControl <> nil) and - (F.ActiveControl.ToBeVisible) and - (F.ActiveControl.IsButton) and - (F.ActiveControl.Count = 0) then - Btn := F.ActiveControl; - if Btn <> nil then - begin - if Msg.message = WM_KEYDOWN then + if (Msg.wParam = VK_RETURN) and + {$IFDEF USE_FLAGS} ( (G6_AllBtnReturnClick in F.fFlagsG6) + or(G6_AllBtnReturnClick in fFlagsG6)) + {$ELSE} (F.fAllBtnReturnClick or fAllBtnReturnClick) {$ENDIF} + and (F.ActiveControl <> nil) and + (F.ActiveControl.ToBeVisible) and + {$IFDEF USE_FLAGS} (G5_IsButton in F.ActiveControl.fFlagsG5) + {$ELSE} (F.ActiveControl.IsButton) {$ENDIF} + and (F.ActiveControl.Count = 0) then + Btn := F.ActiveControl; + if Btn <> nil then begin + if Msg.message = WM_KEYDOWN then + begin + {$IFDEF CLICK_DEFAULT_CANCEL_BTN_DIRECTLY} + {$IFDEF NIL_EVENTS} + if Assigned( Btn.EV.fOnClick ) then + {$ENDIF} + Btn.EV.fOnClick( Btn ); + {$ELSE} + Btn.Focused := TRUE; + {$ENDIF} + end; {$IFDEF CLICK_DEFAULT_CANCEL_BTN_DIRECTLY} - //Btn.Click; - if Assigned( Btn.OnClick ) then - Btn.OnClick( Btn ); {$ELSE} - Btn.Focused := TRUE; + Btn.Perform( Msg.message, DWORD( ' ' ), Msg.lParam ); {$ENDIF} - end; - {$IFDEF CLICK_DEFAULT_CANCEL_BTN_DIRECTLY} - {$ELSE} - Btn.Perform( Msg.message, DWORD( ' ' ), Msg.lParam ); - {$ENDIF} - Msg.wParam := 0; - Result := TRUE; - Rslt := 0; - Exit; - end + Msg.wParam := 0; + Result := TRUE; + Rslt := 0; + Exit; + end end; Result := FALSE; end; -//[procedure TControl.SetDefaultBtn] procedure TControl.SetDefaultBtn(const Index: Integer; const Value: Boolean); var F, C: PControl; begin if Index = 13 then begin - fDefaultBtn := Value; + {$IFDEF USE_FLAGS} if Value + then include( fFlagsG6, G6_DefaultBtn ) + else exclude( fFlagsG6, G6_DefaultBtn ); + {$ELSE} fDefaultBtn := Value; {$ENDIF} {$IFDEF DEFAULT_CANCEL_BTN_EXCLUSIVE} - fCancelBtn := FALSE; + {$IFDEF USE_FLAGS} Exclude( fFlagsG6, G6_CancelBtn ); + {$ELSE} fCancelBtn := FALSE; {$ENDIF} {$ENDIF} end else - if Index = 27 then + if Index = 27 then // this check is necessary still could be Index = 0 to reset bath ! begin - fCancelBtn := Value; + {$IFDEF USE_FLAGS} if Value + then include( fFlagsG6, G6_CancelBtn ) + else exclude( fFlagsG6, G6_CancelBtn ); + {$ELSE} fCancelBtn := Value; {$ENDIF} + {$IFDEF DEFAULT_CANCEL_BTN_EXCLUSIVE} - fDefaultBtn := FALSE; + {$IFDEF USE_FLAGS} Exclude( fFlagsG6, G6_DefaultBtn ); + {$ELSE} fDefaultBtn := FALSE; {$ENDIF} {$ENDIF} end; if Applet = nil then Exit; @@ -59993,46 +59110,43 @@ begin begin if Value then begin - if @ Applet.fOnMessage <> @ TControl.DefaultBtnProc then - Applet.fOldOnMessage := Applet.fOnMessage; // fixed by YS - Applet.fOnMessage := Applet.DefaultBtnProc; + if @ Applet.EV.fOnMessage <> @ TControl.DefaultBtnProc then + Applet.EV.fOldOnMessage := Applet.EV.fOnMessage; // fixed by YS + Applet.EV.fOnMessage := Applet.DefaultBtnProc; end else begin - Applet.fOnMessage := Applet.fOldOnMessage; - Applet.fOldOnMessage := nil; + Applet.EV.fOnMessage := Applet.EV.fOldOnMessage; + Applet.EV.fOldOnMessage := nil; end; C := nil; - if Value then C := @ Self; - if Index = 13 then + if Value then C := @ Self; + if Index = 13 then begin - F.fDefaultBtnCtl := C; - {$IFDEF NO_DEFAULT_BUTTON_BOLD} - {$ELSE} - if Value then - Style := Style or BS_DEFPUSHBUTTON - else - Style := Style and not BS_DEFPUSHBUTTON; - {$ENDIF} + F.PropInt[ @DFLT_BTN ] := Integer( C ); // .DF.fDefaultBtnCtl := C; + {$IFDEF NO_DEFAULT_BUTTON_BOLD} + {$ELSE} + if Value then + Style := Style or BS_DEFPUSHBUTTON + else + Style := Style and not BS_DEFPUSHBUTTON; + {$ENDIF} end - else - if Index = 27 then - F.fCancelBtnCtl := C; + else if Index = 27 then + F.PropInt[ @CNCL_BTN ] := Integer( C ); // .DF.fCancelBtnCtl := C; end; end; -{$IFDEF F_P} -//[function TControl.GetDefaultBtn] function TControl.GetDefaultBtn(const Index: Integer): Boolean; begin CASE Index OF - 13: Result := fDefaultBtn; - 27: Result := fCancelBtn; + 13 : Result := {$IFDEF USE_FLAGS} G6_DefaultBtn in fFlagsG6 + {$ELSE} fDefaultBtn {$ENDIF}; + else Result := {$IFDEF USE_FLAGS} G6_CancelBtn in fFlagsG6 + {$ELSE} fCancelBtn {$ENDIF}; END; end; -{$ENDIF F_P} -//[function TControl.AllBtnReturnClick] function TControl.AllBtnReturnClick: PControl; {$IFDEF ALL_BUTTONS_RESPOND_TO_ENTER} begin @@ -60044,13 +59158,13 @@ var F: PControl; begin SetDefaultBtn( 0, TRUE ); F := ParentForm; - if F <> nil then - F.fAllBtnReturnClick := TRUE; + if F <> nil then + {$IFDEF USE_FLAGS} include( F.fFlagsG6, G6_AllBtnReturnClick ); + {$ELSE} F.fAllBtnReturnClick := TRUE; {$ENDIF} Result := @ Self; end; {$ENDIF} -//[function WndProc_CNDrawItem] function WndProc_CNDrawItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; type PDrawAction = ^TDrawAction; @@ -60061,29 +59175,33 @@ begin if Msg.message = CN_DRAWITEM then begin DI := Pointer( Msg.lParam ); - if Assigned( Sender.OnDrawItem ) then + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.fOnDrawItem ) then + {$ENDIF} begin - if Sender.OnDrawItem( Sender, DI.hDC, DI.rcItem, DI.itemID, - PDrawAction( @ DI.itemAction )^, - PDrawState( @ DI.itemState )^ ) + if Sender.EV.fOnDrawItem( Sender, DI.hDC, DI.rcItem, DI.itemID, + PDrawAction( @ DI.itemAction )^, + PDrawState( @ DI.itemState )^ ) then Rslt := 1 else Rslt := 0; - Result := TRUE; + Result := TRUE; end - else Rslt := 0; + {$IFDEF NIL_EVENTS} + else Rslt := 0 + {$ENDIF} + ; end; end; -//[procedure TControl.SetOnDrawItem] procedure TControl.SetOnDrawItem(const Value: TOnDrawItem); begin - fOnDrawItem := Value; - if Parent <> nil then - Parent.AttachProc( @WndProc_DrawItem ); + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnDrawItem := Value; + if Parent <> nil then + Parent.AttachProc( @WndProc_DrawItem ); AttachProc( @WndProc_CNDrawItem ); end; -//[function WndProc_MeasureItem] function WndProc_MeasureItem( Sender: PControl; var Msg: TMsg; var Rslt: Integer ) : Boolean; var MI: PMeasureItemStruct; @@ -60099,14 +59217,16 @@ begin Control := Sender.Children[ I ]; if Control.Menu = MI.CtlID then begin - if Assigned( Control.OnMeasureItem ) then + {$IFDEF NIL_EVENTS} + if Assigned( Control.EV.fOnMeasureItem ) then + {$ENDIF} begin - MI.itemHeight := Control.OnMeasureItem( Control, MI.itemID ); - if MI.itemHeight > 0 then - begin - Rslt := 1; - Result := TRUE; - end; + MI.itemHeight := Control.EV.fOnMeasureItem( Control, MI.itemID ); + if MI.itemHeight > 0 then + begin + Rslt := 1; + Result := TRUE; + end; end; break; end; @@ -60114,15 +59234,14 @@ begin end; end; -//[procedure TControl.SetOnMeasureItem] procedure TControl.SetOnMeasureItem(const Value: TOnMeasureItem); begin - fOnMeasureItem := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .fOnMeasureItem := Value; if Parent <> nil then Parent.AttachProc( @WndProc_MeasureItem ); end; -//[function TControl.GetItemData] function TControl.GetItemData(Idx: Integer): DWORD; begin Result := 0; @@ -60130,20 +59249,17 @@ begin Result := Perform( fCommandActions.aGetItemData, Idx, 0 ); end; -//[procedure TControl.SetItemData] procedure TControl.SetItemData(Idx: Integer; const Value: DWORD); begin if fCommandActions.aSetItemData <> 0 then Perform( fCommandActions.aSetItemData, Idx, Value ); end; -//[function TControl.GetLVCurItem] function TControl.GetLVCurItem: Integer; begin Result := Perform( LVM_GETNEXTITEM, -1, LVNI_SELECTED ); end; -//[procedure TControl.SetLVCurItem] procedure TControl.SetLVCurItem(const Value: Integer); begin if (lvoMultiselect in LVOptions) or (Value <> LVCurItem ) then @@ -60152,44 +59268,39 @@ begin LVItemState[ Value ] := [ lvisSelect, lvisFocus ]; end; -//[function TControl.LVNextItem] function TControl.LVNextItem(IdxPrev: Integer; Attrs: DWORD): Integer; begin Result := Perform( LVM_GETNEXTITEM, IdxPrev, Attrs ); end; -//[function TControl.LVNextSelected] function TControl.LVNextSelected(IdxPrev: Integer): Integer; begin Result := Perform( LVM_GETNEXTITEM, IdxPrev, LVNI_SELECTED ); end; -//[function TControl.GetLVFocusItem] function TControl.GetLVFocusItem: Integer; begin Result := Perform( LVM_GETNEXTITEM, -1, LVNI_FOCUSED ); end; -//[procedure TControl.Close] procedure TControl.Close; begin PostMessage( Handle, WM_CLOSE, 0, 0 ); end; -//[function WndProcMinimize] function WndProcMinimize( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Wnd: PControl; begin Result := FALSE; - if (Msg.message = WM_SYSCOMMAND) and ((Msg.wParam and $FFF0) = SC_MINIMIZE)then + if (Msg.message = WM_SYSCOMMAND) and ((Msg.wParam and $FFF0) = SC_MINIMIZE)then begin - if Applet <> nil then - begin - Wnd := Applet.FMinimizeWnd; - if Wnd <> nil then - SetWindowPos( Applet.Handle, 0, Wnd.Left, Wnd.Top, Wnd.Width, 0, - SWP_NOZORDER or SWP_NOREDRAW); - end; + if Applet <> nil then + begin + Wnd := Pointer( Applet.PropInt[ @MIN_WND ] ); // fMinimizeWnd; + if Wnd <> nil then + SetWindowPos( Applet.Handle, 0, Wnd.Left, Wnd.Top, Wnd.Width, 0, + SWP_NOZORDER or SWP_NOREDRAW); + end; end; end; @@ -60203,19 +59314,19 @@ begin SW_PARENTCLOSING: begin if IsIconic( Self_.fHandle ) then - Self_.fShowAction := SW_SHOWMINNOACTIVE + Self_.DF.fShowAction := SW_SHOWMINNOACTIVE else if IsZoomed( Self_.fHandle ) then - Self_.fShowAction := SW_SHOWMAXIMIZED + Self_.DF.fShowAction := SW_SHOWMAXIMIZED else - Self_.fShowAction := SW_SHOWNOACTIVATE; + Self_.DF.fShowAction := SW_SHOWNOACTIVATE; end; SW_PARENTOPENING: begin - if Self_.fShowAction <> 0 then + if Self_.DF.fShowAction <> 0 then begin - ShowWindow( Self_.fHandle, Self_.fShowAction ); - Self_.fShowAction := 0; + ShowWindow( Self_.fHandle, Self_.DF.fShowAction ); + Self_.DF.fShowAction := 0; end; Rslt := 0; end; @@ -60224,25 +59335,23 @@ begin END; end; -//[procedure TControl.MinimizeNormalAnimated] procedure TControl.MinimizeNormalAnimated; var App: PControl; begin App := Applet; - if App = nil then - App := @Self; - App.FMinimizeWnd := @Self; + if App = nil then + App := @Self; + App.PropInt[ @MIN_WND ] // fMinimizeWnd + := Integer( @Self ); App.AttachProc( @WndProcMinimize ); AttachProc( @WndProcRestore ); end; -//[procedure TCotrol.RestoreNormalMaximized] procedure TControl.RestoreNormalMaximized; begin AttachProc( @WndProcRestore ); end; -//[function WndProcDropFiles] function WndProcDropFiles( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var hDrop: THandle; Pt: TPoint; @@ -60250,38 +59359,38 @@ var hDrop: THandle; I, N: Integer; Buf: array[ 0..MAX_PATH ] of KOLChar; begin - if Msg.message = WM_DROPFILES then - if Assigned( Sender.FOnDropFiles ) then + if Msg.message = WM_DROPFILES then + //if Assigned( Sender.EV.FOnDropFiles ) then + if TMethod(Sender.EV.fOnDropFiles).Data <> nil then begin - hDrop := Msg.wParam; - DragQueryPoint( hDrop, Pt ); - N := DragQueryFile( hDrop, $FFFFffff, nil, 0 ); - FList := ''; - for I := 0 to N-1 do - begin - if FList <> '' then - FList := FList + #13; - DragQueryFile( hDrop, I, Buf, Sizeof( Buf ) ); - FList := FList + Buf; - end; - DragFinish( hDrop ); - Sender.FOnDropFiles( Sender, FList, Pt ); - Rslt := 0; - Result := TRUE; - Exit; + hDrop := Msg.wParam; + DragQueryPoint( hDrop, Pt ); + N := DragQueryFile( hDrop, $FFFFffff, nil, 0 ); + FList := ''; + for I := 0 to N-1 do + begin + if FList <> '' then + FList := FList + #13; + DragQueryFile( hDrop, I, Buf, Sizeof( Buf ) ); + FList := FList + Buf; + end; + DragFinish( hDrop ); + Sender.EV.FOnDropFiles( Sender, FList, Pt ); + Rslt := 0; + Result := TRUE; + Exit; end; Result := FALSE; end; -//[procedure TControl.SetOnDropFiles] procedure TControl.SetOnDropFiles(const Value: TOnDropFiles); begin - FOnDropFiles := Value; - AttachProc( @WndProcDropFiles ); - DragAcceptFiles( GetWindowHandle, Assigned( Value ) ); + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .FOnDropFiles := Value; + AttachProc( @WndProcDropFiles ); + DragAcceptFiles( GetWindowHandle, Assigned( Value ) ); end; -//[function WndProcShowHide] function WndProcShowHide( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var IsVisible: Boolean; begin @@ -60291,37 +59400,41 @@ begin IsVisible := IsWindowVisible( Sender.Handle ); if LongBool( Msg.wParam ) then begin - Sender.fVisible := TRUE; - if not IsVisible then - if Assigned( Sender.FOnShow ) then - Sender.FOnShow( Sender ); - end - else + {$IFDEF USE_FLAGS} include( Sender.fStyle.f3_Style, F3_Visible ); + {$ELSE} Sender.fVisible := TRUE; {$ENDIF} + if not IsVisible then + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.FOnShow ) then + {$ENDIF} + Sender.EV.FOnShow( Sender ); + end else begin - Sender.fVisible := FALSE; - if IsVisible then - if Assigned( Sender.FOnHide ) then - Sender.FOnHide( Sender ); + {$IFDEF USE_FLAGS} exclude( Sender.fStyle.f3_Style, F3_Visible ); + {$ELSE} Sender.fVisible := FALSE; {$ENDIF} + if IsVisible then + {$IFDEF NIL_EVENTS} + if Assigned( Sender.EV.FOnHide ) then + {$ENDIF} + Sender.EV.FOnHide( Sender ); end; end; Result := FALSE; end; -//[procedure TControl.SetOnHide] procedure TControl.SetOnHide(const Value: TOnEvent); begin - FOnHide := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .FOnHide := Value; AttachProc( WndProcShowHide ); end; -//[procedure TControl.SetOnShow] procedure TControl.SetOnShow(const Value: TOnEvent); begin - FOnShow := Value; + {$IFDEF EVENTS_DYNAMIC} ProvideUniqueEvents {$ELSE} EV {$ENDIF} + .FOnShow := Value; AttachProc( WndProcShowHide ); end; -//[function TControl.BringToFront] function TControl.BringToFront: PControl; begin SetWindowPos( GetWindowHandle, HWND_TOP, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or @@ -60329,7 +59442,6 @@ begin Result := @Self; end; -//[function TControl.SendToBack] function TControl.SendToBack: PControl; begin SetWindowPos( GetWindowHandle, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE or @@ -60337,56 +59449,70 @@ begin Result := @Self; end; -//[procedure TControl.DragStart] procedure TControl.DragStart; begin PostMessage( GetWindowHandle, WM_SYSCOMMAND, $F012, 0 ); end; -//[function WndProcDragWindow] function WndProcDragWindow( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var P: TPoint; + Delta: DWORD; + dX, dY: Integer; begin - if Msg.message = WM_MOUSEMOVE then + if Msg.message = WM_MOUSEMOVE then begin - if Sender.FDragging then - begin - GetCursorPos( P ); - P.x := P.x - Sender.fMouseStartPos.x + Sender.fDragStartPos.x; - P.y := P.y - Sender.fMouseStartPos.y + Sender.fDragStartPos.y; - Sender.Position := P; - end; + if {$IFDEF USE_FLAGS} G6_Dragging in Sender.fFlagsG6 + {$ELSE} Sender.FDragging {$ENDIF} then + begin + GetCursorPos( P ); + Delta := Sender.PropInt[ @DRAG_XY ]; + dX := SmallInt( LoWord( Delta ) ); + dY := SmallInt( HiWord( Delta ) ); + P.x := P.x + dX; // - Sender.fMouseStartPos.x + Sender.fDragStartPos.x; + P.y := P.y + dY; // - Sender.fMouseStartPos.y + Sender.fDragStartPos.y; + Sender.Position := P; + end; end; Result := FALSE; end; -//[procedure TControl.DragStartEx] procedure TControl.DragStartEx; var StartBounds: TRect; + MSP: TPoint; + dX, dY: Integer; + Delta: Integer; begin {$IFNDEF SMALLEST_CODE} - if fDragging then Exit; + if {$IFDEF USE_FLAGS} G6_Dragging in fFlagsG6 + {$ELSE} fDragging {$ENDIF} then Exit; {$ENDIF} - GetCursorPos( fMouseStartPos ); + GetCursorPos( MSP ); StartBounds := BoundsRect; + dX := StartBounds.Left - MSP.X; + dY := StartBounds.Top - MSP.Y; + Delta := (dX and $FFFF) or (dY shl 16); + PropInt[ @DRAG_XY ] := Delta; + {fMouseStartPos.x := MSP.X; + fMouseStartPos.y := MSP.Y; fDragStartPos.x := StartBounds.Left; - fDragStartPos.y := StartBounds.Top; + fDragStartPos.y := StartBounds.Top;} SetCapture( GetWindowHandle ); - fDragging := TRUE; + {$IFDEF USE_FLAGS} include( fFlagsG6, G6_Dragging ); + {$ELSE} fDragging := TRUE; {$ENDIF} AttachProc( WndProcDragWindow ); end; -//[procedure TControl.DragStopEx] procedure TControl.DragStopEx; begin - if FDragging then + if {$IFDEF USE_FLAGS} G6_Dragging in fFlagsG6 + {$ELSE} FDragging {$ENDIF} then begin - ReleaseCapture; - FDragging := FALSE; + ReleaseCapture; + {$IFDEF USE_FLAGS} exclude( fFlagsG6, G6_Dragging ); + {$ELSE} FDragging := FALSE; {$ENDIF} end; end; -//[function CallDragCallBack] function CallDragCallBack( Sender: PControl; var Stop: Boolean ): Boolean; var P: TPoint; Shape, ShapeWas: Integer; @@ -60395,7 +59521,7 @@ begin GetCursorPos( P ); Shape := LoadCursor( 0, PKOLChar(IDC_HAND) ); ShapeWas := Shape; - Result := Sender.fDragCallback( Sender, P.x, P.y, Shape, Stop ); + Result := Sender.EV.fDragCallback( Sender, P.x, P.y, Shape, Stop ); if not Stop then begin if not Result then @@ -60411,61 +59537,60 @@ begin Windows.SetCursor( Shape ); end; -//[function WndProcDrag] function WndProcDrag( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var Stop: Boolean; begin - if Sender.fDragging then + if {$IFDEF USE_FLAGS} G6_Dragging in Sender.fFlagsG6 + {$ELSE} Sender.fDragging {$ENDIF} then begin - Stop := FALSE; - case Msg.message of - WM_MOUSEMOVE: - CallDragCallBack( Sender, Stop ); - WM_LBUTTONUP, WM_RBUTTONUP: - begin - Stop := TRUE; + Stop := FALSE; + case Msg.message of + WM_MOUSEMOVE: CallDragCallBack( Sender, Stop ); - end; - else - begin - Result := FALSE; - Exit; - end; - end; - if Stop then - begin - ReleaseCapture; - Sender.fDragging := FALSE; - end + WM_LBUTTONUP, WM_RBUTTONUP: + begin + Stop := TRUE; + CallDragCallBack( Sender, Stop ); + end; else - begin - Result := TRUE; - exit; - end; + begin + Result := FALSE; + Exit; + end; + end; + if Stop then + begin + ReleaseCapture; + {$IFDEF USE_FLAGS} exclude( Sender.fFlagsG6, G6_Dragging ); + {$ELSE} Sender.fDragging := FALSE; {$ENDIF} + end + else + begin + Result := TRUE; + exit; + end; end; Result := FALSE; end; -//[procedure TControl.DragItem] procedure TControl.DragItem(OnDrag: TOnDrag); begin - fDragCallback := OnDrag; - fDragging := TRUE; + EV.fDragCallback := OnDrag; + {$IFDEF USE_FLAGS} include( fFlagsG6, G6_Dragging ); + {$ELSE} fDragging := TRUE; {$ENDIF} SetCapture( GetWindowHandle ); 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; // + //{-2.95}//fWndProcResizeFlicks := WndProcDummy; // fCommandActions.aClear := ClearText; // //fWindowed := True; // is set in TControl.Init fControlClassName := AClassName; // @@ -60479,10 +59604,14 @@ begin fCtl3Dchild := True; // if AParent <> nil then // begin // - fWndProcResizeFlicks := AParent.fWndProcResizeFlicks; // + //{-2.95}//fWndProcResizeFlicks := AParent.fWndProcResizeFlicks; // fGotoControl := AParent.fGotoControl; // - fDoubleBuffered := AParent.fDoubleBuffered; // - fTransparent := AParent.fTransparent; // + {$IFDEF USE_FLAGS} + exc fFlagsG2 := fFlagsG2 - [G2_DoubleBuffered, G2_Transparent] + + (AParent.fFlagsG2 * [G2_DoubleBuffered, G2_Transparent]); + {$ELSE} fDoubleBuffered := AParent.fDoubleBuffered; + fTransparent := AParent.fTransparent; // + {$ENDIF} fCtl3Dchild := AParent.fCtl3Dchild; // if AParent.fCtl3Dchild then // fCtl3D := ACtl3D // @@ -60513,12 +59642,12 @@ begin end; // end; // // -//[constructor TControl.CreateApplet] constructor TControl.CreateApplet(const ACaption: AnsiString); // begin // AppButtonUsed := True; // CreateWindowed( nil, 'App', TRUE ); // - FIsApplet := TRUE; // + {$IFDEF USE_FLAGS} include( fFlagsG3, G3_IsApplet ); + {$ELSE} FIsApplet := TRUE; {$ENDIF} fStyle := WS_VISIBLE or WS_SYSMENU or WS_POPUP or WS_MINIMIZEBOX // or WS_CAPTION; // fExStyle := WS_EX_APPWINDOW; // @@ -60527,7 +59656,6 @@ begin Caption := ACaption; // end; // // -//[constructor TControl.CreateForm] constructor TControl.CreateForm(AParent: PControl; const ACaption: AnsiString); // begin // CreateWindowed( AParent, 'Form', TRUE ); // @@ -60536,7 +59664,6 @@ begin Caption := ACaption; // end; // // -//[constructor TControl.CreateControl] constructor TControl.CreateControl(AParent: PControl; AClassName: PAnsiChar; // AStyle: DWORD; ACtl3D: Boolean; Actions: PCommandActions); // var Form: PControl; // @@ -60572,7 +59699,6 @@ begin AttachProc( WndProcCtrl ); // end; // // -//[constructor TControl.CreateButton] constructor TControl.CreateButton(AParent: PControl; // const ACaption: AnsiString); // begin // @@ -60585,7 +59711,6 @@ begin Caption := ACaption; // end; // // -//[constructor TControl.CreateBitBtn] constructor TControl.CreateBitBtn(AParent: PControl; // const ACaption: AnsiString; AOptions: TBitBtnOptions; ALayout: TGlyphLayout; // AGlyphBitmap: HBitmap; AGlyphCount: Integer); // @@ -60644,20 +59769,22 @@ begin 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; // + False, @LabelActions ); + aAutoSzX := 1; + aAutoSzY := 1; + {$IFDEF USE_FLAGS} fFlagsG1 := fFlagsG1 + [G1_SizeRedraw, G1_IsStaticControl]; + {$ELSE} fSizeRedraw := True; + fIsStaticControl := 1; // + {$ENDIF} // fBoundsRect.Bottom := fBoundsRect.Top + 22; // Caption := ACaption; // end; // // -//[constructor TControl.CreateWordWrapLabel] constructor TControl.CreateWordWrapLabel(AParent: PControl; // const ACaption: AnsiString); // begin // @@ -60666,24 +59793,24 @@ begin 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; // + {$IFDEF USE_FLAGS} exclude( fFlagsG1, G1_IsStaticControl ); + {$ELSE} fIsStaticControl := 0; {$ENDIF} AttachProc( WndProcLabelEffect ); // fTextAlign := taCenter; // fTextColor := clBtnShadow; // fShadowDeep := AShadowDeep; // - fIgnoreWndCaption := True; // + {$IFDEF USE_FLAGS} include( fFlagsG1, G1_IgnoreWndCaption ); + {$ELSE} fIgnoreWndCaption := True; {$ENDIF} // with fBoundsRect do // begin // Bottom := Top + 40; // end; // end; // // -//[constructor TControl.CreatePaintBox] constructor TControl.CreatePaintBox(AParent: PControl); // begin // CreateLabel( AParent, '' ); // @@ -60695,7 +59822,6 @@ begin end; // // {$IFDEF ASM_VERSION} // -//[constructor TControl.CreateGradientPanel] constructor TControl.CreateGradientPanel(AParent: PControl; AColor1, // AColor2: TColor); // asm //cmd //opd // @@ -60733,7 +59859,6 @@ begin end; // {$ENDIF ASM_VERSION} // // -//[constructor TControl.CreateGradientPanelEx] constructor TControl.CreateGradientPanelEx(AParent: PControl; AColor1, // AColor2: TColor; AStyle: TGradientStyle; ALayout: TGradientLayout); // begin // @@ -60750,7 +59875,6 @@ begin end; // end; // // -//[constructor TControl.CreateGroupbox] constructor TControl.CreateGroupbox(AParent: PControl; // const ACaption: AnsiString); // begin // @@ -60768,7 +59892,6 @@ begin fTabstop := False; // end; // // -//[constructor TControl.CreateCheckbox] constructor TControl.CreateCheckbox(AParent: PControl; // const ACaption: AnsiString); // begin // @@ -60781,7 +59904,6 @@ begin BS_AUTOCHECKBOX or WS_TABSTOP; // end; // // -//[constructor TControl.CreateRadiobox] constructor TControl.CreateRadiobox(AParent: PControl; // const ACaption: AnsiString); // begin // @@ -60800,7 +59922,6 @@ begin end; // end; // // -//[constructor TControl.CreateEditbox] constructor TControl.CreateEditbox(AParent: PControl; // AOptions: TEditOptions); // var Flags: Integer; // @@ -60810,6 +59931,7 @@ begin 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 ); // + aAutoSzY := 6; //YS fCursor := LoadCursor( 0, IDC_IBEAM ); // //YS with fBoundsRect do // begin // @@ -60823,18 +59945,19 @@ begin end; // fColor := clWindow; // fLookTabKeys := [ tkTab, tkUpDown, tkPageUpPageDn ]; // - if eoMultiline in AOptions then // - fLookTabKeys := [ tkTab ]; // - if eoWantTab in AOptions then // - fLookTabKeys := fLookTabKeys - [ tkTab ]; // + if eoMultiline in AOptions then // + fLookTabKeys := [ tkTab ]; // + if eoWantTab in AOptions then // + exclude( fLookTabKeys, tkTab ); end; // // -//[constructor TControl.CreatePanel] constructor TControl.CreatePanel(AParent: PControl; AStyle: TEdgeStyle); // begin // CreateControl( AParent, 'STATIC', WS_VISIBLE or WS_CHILD or // SS_LEFTNOWORDWRAP or SS_NOPREFIX or SS_NOTIFY, False, // - @LabelActions ); // + @LabelActions ); + aAutoSzX := 1; + aAutoSzY := 1; with fBoundsRect do // begin // Right := Left + 100; // @@ -60844,7 +59967,6 @@ begin ExStyle := ExStyle or WS_EX_CONTROLPARENT; // end; // // -//[constructor TControl.CreateSplitter] constructor TControl.CreateSplitter(AParent: PControl; AMinSizePrev, // AMinSizeNext: Integer; EdgeStyle: TEdgeStyle); // var PrevCtrl: PControl; // @@ -60880,7 +60002,6 @@ begin AttachProc( WndProcSplitter ); // end; // // -//[constructor TControl.CreateListbox] constructor TControl.CreateListbox(AParent: PControl; // AOptions: TListOptions); // var Flags: Integer; // @@ -60898,7 +60019,6 @@ begin fLookTabKeys := [ tkTab, tkLeftRight ]; // end; // // -//[constructor TControl.CreateCombobox] constructor TControl.CreateCombobox(AParent: PControl; // AOptions: TComboOptions); // var Flags: Integer; // @@ -60908,8 +60028,9 @@ begin WS_VISIBLE or WS_CHILD or WS_VSCROLL or // CBS_DROPDOWN or CBS_HASSTRINGS or WS_TABSTOP or Flags, // True, @ComboActions ); // + aAutoSzY := 6; fCreateWndExt := CreateComboboxWnd; // - fDropDownProc := ComboboxDropDown; // + //fDropDownProc := ComboboxDropDown; // fClsStyle := fClsStyle or CS_DBLCLKS; // with fBoundsRect do // begin // @@ -60922,14 +60043,14 @@ begin 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; // + {$IFDEF USE_FLAGS} include( fFlagsG2, G2_IsCommonCtl ); + {$ELSE} fIsCommonControl := True; {$ENDIF} if AParent <> nil then // begin // AttachProc( WndProcParentResize ); // @@ -60939,7 +60060,6 @@ begin end; // end; // // -//[constructor TControl.CreateRichEdit1] constructor TControl.CreateRichEdit1(AParent: PControl; // AOptions: TEditOptions); // var Flags, I: Integer; // @@ -60961,8 +60081,10 @@ begin True, @RichEditActions ); // // AttachProc( WndProcRichEditNotify ); // - fDoubleBuffered := False; // - fCannotDoubleBuf := True; // + {$IFDEF USE_FLAGS} exclude( fFlagsG2, G2_DoubleBuffered ); + {$ELSE} fDoubleBuffered := False; {$ENDIF} + {$IFDEF USE_FLAGS} include( fFlagsG1, G1_CanNotDoublebuf ); + {$ELSE} fCannotDoubleBuf := True; {$ENDIF} // with fBoundsRect do // begin // Right := Right + 100; // @@ -60978,8 +60100,6 @@ begin Perform( EM_SETBKGNDCOLOR, 0, Color2RGB(fColor)); // end; // // - // -//[constructor TControl.CreateRichEdit] constructor TControl.CreateRichEdit(AParent: PControl; // AOptions: TEditOptions); // var OldRichEditClass, OldRichEditLib: PAnsiChar; // @@ -60998,7 +60118,6 @@ begin CreateRichEdit1( AParent, AOptions ); // end; // // -//[constructor TControl.CreateProgressbar] constructor TControl.CreateProgressbar(AParent: PControl); // const ProgressBarFlags: array[ TProgressbarOption ] of Integer = // (PBS_VERTICAL, PBS_SMOOTH ); // @@ -61014,7 +60133,6 @@ begin fTextColor := clHighlight; // end; // // -//[constructor TControl.CreateProgressbarEx] constructor TControl.CreateProgressbarEx(AParent: PControl; // AOptions: TProgressbarOptions); // const ProgressBarFlags: array[ TProgressbarOption ] of Integer = // @@ -61024,7 +60142,6 @@ begin fStyle := fStyle or DWORD( MakeFlags( @AOptions, ProgressBarFlags ) ); // end; // // -//[constructor TControl.CreateListView] constructor TControl.CreateListView(AParent: PControl; // AStyle: TListViewStyle; AOptions: TListViewOptions; AImageListSmall, // AImageListNormal, AImageListState: PImageList); // @@ -61047,7 +60164,6 @@ begin fLookTabKeys := [ tkTab ]; // end; // // -//[constructor TControl.CreateTreeView] constructor TControl.CreateTreeView(AParent: PControl; // AOptions: TTreeViewOptions; AImgListNormal, AImgListState: PImageList); // var Flags: Integer; // @@ -61068,7 +60184,6 @@ begin fLookTabKeys := [ tkTab ]; // end; // // -//[constructor TControl.CreateTabControl] constructor TControl.CreateTabControl(AParent: PControl; ATabs: array of String;// AOptions: TTabControlOptions; // AImgList: PImageList; AImgList1stIdx: Integer); // @@ -61100,16 +60215,15 @@ begin 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 ]; // + if not( tboTextBottom in AOptions ) then // + include( AOptions, tboTextRight ); + if tboTextRight in AOptions then // + exclude( AOptions, tboTextBottom ); Flags := MakeFlags( @AOptions, ToolbarOptions ); // CreateCommonControl( AParent, TOOLBARCLASSNAME, ToolbarAligns[ Align ] or // WS_CHILD or WS_VISIBLE {or WS_TABSTOP} // @@ -61150,7 +60264,6 @@ begin Perform( WM_SIZE, 0, 0 ); // end; // // -//[constructor TImageList.CreateImageList] constructor TImageList.CreateImageList(POwner: Pointer); // var AOwner: PControl; // begin // @@ -61170,7 +60283,6 @@ begin AOwner.fImageList := @Self; // end; // // -//[constructor TThread.ThreadCreate] constructor TThread.ThreadCreate; // begin // IsMultiThread := True; // @@ -61184,7 +60296,6 @@ begin FThreadID ); // receive thread ID // end; // // -//[constructor TThread.ThreadCreateEx] constructor TThread.ThreadCreateEx( const Proc: TOnThreadExecute ); // begin // ThreadCreate; // @@ -61193,9 +60304,7 @@ begin end; // // {$ENDIF USE_CONSTRUCTORS} //****************************************************// -{+} -//[procedure InvalidateExW] procedure InvalidateExW( Wnd: HWnd ); begin InvalidateRect( Wnd, nil, TRUE ); @@ -61207,14 +60316,12 @@ begin end; end; -//[procedure TControl.InvalidateEx] procedure TControl.InvalidateEx; begin if fHandle = 0 then Exit; InvalidateExW( fHandle ); end; -//[procedure InvalidateNCW] procedure InvalidateNCW( Wnd: HWnd; Recursive: Boolean ); begin SendMessage( Wnd, WM_NCPAINT, 1, 0 ); @@ -61227,15 +60334,13 @@ begin end; end; -//[procedure TControl.InvalidateNC] procedure TControl.InvalidateNC(Recursive: Boolean); begin if fHandle = 0 then Exit; InvalidateNCW( fHandle, Recursive ); end; -//[procedure TControl.SetClientMargin] -procedure TControl.SetClientMargin(const Index, Value: Integer); +procedure TControl.SetClientMargin(const Index: Integer; Value: ShortInt); begin case Index of 1: fClientTop := Value; @@ -61248,7 +60353,6 @@ begin end; {$IFDEF F_P} -//[function TControl.GetClientMargin] function TControl.GetClientMargin(const Index: Integer): Integer; begin CASE Index OF @@ -61299,14 +60403,15 @@ begin Inc( R.Left, 4 ); ParentHavingFont := Ctl; - while (ParentHavingFont <> nil) and not Assigned( ParentHavingFont.FFont ) - and not ParentHavingFont.IsForm do + while (ParentHavingFont <> nil) and ( ParentHavingFont.FFont = nil ) + and {$IFDEF USE_FLAGS} not(G3_IsForm in ParentHavingFont.fFlagsG3) + {$ELSE} not ParentHavingFont.IsForm {$ENDIF} do ParentHavingFont := ParentHavingFont.Parent; OldFont := 0; - if Assigned( ParentHavingFont ) then + if ( ParentHavingFont <> nil ) then begin - OldFont := SelectObject( DC, ParentHavingFont.Font.Handle ); - SetTextColor( DC, ParentHavingFont.Font.FColorRGB ); + OldFont := SelectObject( DC, ParentHavingFont.Font.Handle ); + SetTextColor( DC, ParentHavingFont.Font.FColorRGB ); end; R1 := R; @@ -61332,15 +60437,17 @@ begin END; OffsetRect( R, dX, dY ); - if Ctl.fEnabled or (Flags and $80000000 <> 0) then + if {$IFDEF USE_FLAGS} not(F3_Disabled in Ctl.fStyle.f3_Style) + {$ELSE} Ctl.fEnabled {$ENDIF} + or (Flags and $80000000 <> 0) then begin - OldBk := SetBkMode( DC, TRANSPARENT ); - OldBrush := SelectObject( DC, GetStockObject( NULL_BRUSH ) ); - {$IFDEF UNICODE_CTRLS}Windows.DrawTextW - {$ELSE} Windows.DrawTextA - {$ENDIF}( DC, PKOLChar( Ctl.Caption ), Length( Ctl.Caption ), R, Fmt ); - SelectObject( DC, OldBrush ); - SetBkMode( DC, OldBk ); + OldBk := SetBkMode( DC, TRANSPARENT ); + OldBrush := SelectObject( DC, GetStockObject( NULL_BRUSH ) ); + {$IFDEF UNICODE_CTRLS}Windows.DrawTextW + {$ELSE} Windows.DrawTextA + {$ENDIF}( DC, PKOLChar( Ctl.Caption ), Length( Ctl.Caption ), R, Fmt ); + SelectObject( DC, OldBrush ); + SetBkMode( DC, OldBk ); end else begin @@ -61352,8 +60459,8 @@ begin Integer( @ GTD ), Length( Ctl.fCaption ), R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top, DST_COMPLEX or DSS_DISABLED ); end; - if Assigned( ParentHavingFont ) then - SelectObject( DC, OldFont ); + if ( ParentHavingFont <> nil ) then + SelectObject( DC, OldFont ); end; {$IFDEF USE_GRAPHCTLS} @@ -61417,18 +60524,19 @@ var OldFont: Integer; ParentHavingFont: PControl; begin ParentHavingFont := Ctl; - while (ParentHavingFont <> nil) and not Assigned( ParentHavingFont.FFont ) - and not ParentHavingFont.IsForm do + while (ParentHavingFont <> nil) and ( ParentHavingFont.FFont = nil ) + and {$IFDEF USE_FLAGS} not(G3_IsForm in ParentHavingFont.fFlagsG3) + {$ELSE} not ParentHavingFont.IsForm {$ENDIF} do ParentHavingFont := ParentHavingFont.Parent; OldFont := 0; - if Assigned( ParentHavingFont ) then - OldFont := SelectObject( DC, ParentHavingFont.Font.Handle ); + if ( ParentHavingFont <> nil ) then + OldFont := SelectObject( DC, ParentHavingFont.Font.Handle ); OldBrush := SelectObject( DC, GetStockObject( NULL_BRUSH ) ); fDrawThemeText( Theme, DC, CtlType, CtlStates, @ WideString( Ctl.fCaption )[ 1 ], Length( Ctl.fCaption ), Flags1, Flags2, @ R ); SelectObject( DC, OldBrush ); - if Assigned( ParentHavingFont ) then - SelectObject( DC, OldFont ); + if ( ParentHavingFont <> nil ) then + SelectObject( DC, OldFont ); end; {$ENDIF} @@ -61443,8 +60551,10 @@ begin C := Self_.Children[ i ]; if not C.Visible then continue; R := C.BoundsRect; - if (C.Handle = 0) and not C.fWindowed and - Assigned( C.fPaintProc ) then + if (C.Handle = 0) + and {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6) + {$ELSE} not C.fWindowed {$ENDIF} + {$IFDEF SAFE_CODE} and Assigned( C.EV.fPaintProc ) {$ENDIF} then begin sav := SaveDC( DC ); rgn := CreateRectRgnIndirect( R ); @@ -61458,18 +60568,22 @@ begin Self_.Canvas.Font.Assign( Self_.Font ); // не присваивается? Self_.fCanvas.DeselectHandles; // не помогает??? - if Assigned( C.OnPrepaint ) then - C.OnPrePaint( C, DC ); + {$IFDEF NIL_EVENTS} + if Assigned( C.EV.fOnPrepaint ) then + {$ENDIF} + C.EV.fOnPrePaint( C, DC ); - if Assigned( C.OnPaint ) then - C.OnPaint( C, DC ) + if Assigned( C.EV.fOnPaint ) then + C.EV.fOnPaint( C, DC ) else - C.fPaintProc( DC ); + C.EV.fPaintProc( DC ); - if Assigned( C.OnPostPaint ) then - C.OnPostPaint( C, DC ); + {$IFDEF NIL_EVENTS} + if Assigned( C.EV.fOnPostPaint ) then + {$ENDIF} + C.EV.fOnPostPaint( C, DC ); - C.fCanvas := nil; + C.fCanvas := nil; Self_.Canvas.Brush.Assign( Self_.Brush ); Self_.Canvas.Font.Assign( Self_.Font ); @@ -61478,20 +60592,21 @@ begin ExcludeClipRect( DC, R.Left, R.Top, R.Right, R.Bottom ); end; end; - if Self_.fIsGroupBox then + if {$IFDEF USE_FLAGS} G5_IsGroupbox in Self_.fFlagsG5 + {$ELSE} Self_.fIsGroupBox {$ENDIF} then begin - Self_.fErasingBkgnd := TRUE; - R := Self_.BoundsRect; - OffsetRect( R, -R.Left, -R.Top ); - Self_.Canvas.FillRect( R ); - Self_.GroupBoxPaint( DC ); - Self_.fErasingBkgnd := FALSE; + Self_.DF.fErasingBkgnd := TRUE; + R := Self_.BoundsRect; + OffsetRect( R, -R.Left, -R.Top ); + Self_.Canvas.FillRect( R ); + Self_.GroupBoxPaint( DC ); + Self_.DF.fErasingBkgnd := FALSE; end else - if Assigned( Self_.fOnPaint2 ) then - Self_.fOnPaint2( Self_, DC ) + if Assigned( Self_.EV.fOnPaint2 ) then + Self_.EV.fOnPaint2( Self_, DC ) else - Self_.Canvas.FillRect( Self_.ClientRect ); + Self_.Canvas.FillRect( Self_.ClientRect ); end; function WndProc_ParentOfGraphicCtl( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; @@ -61508,14 +60623,26 @@ begin begin //if not Result then begin - WasOnPaint := Self_.fOnPaint; - Self_.fOnPaint2 := Self_.fOnPaint; - Self_.fPaintMsg := Msg; - TMethod( Self_.fOnPaint ) := MakeMethod( Self_, @ PaintGraphicChildren ); + WasOnPaint := Self_.EV.fOnPaint; + Self_.EV.fOnPaint2 := Self_.EV.fOnPaint; + //Self_.fPaintMsg := Msg; + {$IFDEF MAKE_METHOD} + TMethod( Self_.EV.fOnPaint ) := MakeMethod( Self_, @ PaintGraphicChildren ); + {$ELSE} + TMethod( Self_.EV.fOnPaint ).Code := @ PaintGraphicChildren; + TMethod( Self_.EV.fOnPaint ).Data := @ Self_; + {$ENDIF} - save_Paint2 := Self_.fOnPaint2; - if not Assigned( Self_.fOnPaint2 ) then - Self_.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyPaintClear ) ); + save_Paint2 := Self_.EV.fOnPaint2; + if not Assigned( Self_.EV.fOnPaint2 ) then + begin + {$IFDEF MAKE_METHOD} + Self_.EV.fOnPaint2 := TOnPaint( MakeMethod( nil, @ DummyPaintClear ) ); + {$ELSE} + TMethod( Self_.EV.fOnPaint2 ).Code := @ DummyPaintClear; + //TMethod( Self_.EV.fOnPaint2 ).Data := nil; + {$ENDIF} + end; i := Self_.fDynHandlers.fCount; Self_.fDynHandlers.fCount := Self_.fDynHandlers.IndexOf( @ WndProc_ParentOfGraphicCtl ); @@ -61526,7 +60653,7 @@ begin if not Result then {Result :=} WndProcPaint( Self_, Msg, Rslt ); - Self_.fOnPaint := WasOnPaint; + Self_.EV.fOnPaint := WasOnPaint; end; Result := TRUE; end @@ -61541,12 +60668,17 @@ begin C := Self_.fPushedBtn else C := Self_.Children[ i ]; - if (C = Self_.fPushedBtn) OR - C.fVisible and C.fEnabled and PtInRect( C.BoundsRect, Pt ) then + if (C = Self_.fPushedBtn) OR + {$IFDEF USE_FLAGS} + (F3_Visible in C.fStyle.f3_Style) + and not (F3_Disabled in C.fStyle.f3_Style) + {$ELSE} C.fVisible and C.fEnabled {$ENDIF} + and PtInRect( C.BoundsRect, Pt ) then begin - if not C.fWindowed and - (C.fCursor <> 0) and (C.fCursor <> Self_.fCursor) and - (ScreenCursor = 0) then + if {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6) + {$ELSE} not C.fWindowed {$ENDIF} + and (C.fCursor <> 0) and (C.fCursor <> Self_.fCursor) and + (ScreenCursor = 0) then begin if Self_.fSaveCursor = 0 then begin @@ -61558,40 +60690,54 @@ begin Windows.SetCursor( C.fCursor ); end; {$IFDEF GRAPHCTL_HOTTRACK} - if not C.fWindowed and (Applet.fHotCtl <> C) then + if {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6) + {$ELSE} not C.fWindowed {$ENDIF} + and (Applet.DF.fHotCtl <> C) then begin - if Applet.fHotCtl <> nil then + if Applet.DF.fHotCtl <> nil then begin - Applet.fHotCtl.fHot := FALSE; - if not Applet.fHotCtl.fWindowed then - begin - Applet.fHotCtl.Invalidate; - if Assigned( Applet.fHotCtl.OnMouseLeave ) then - Applet.fHotCtl.OnMouseLeave( Applet.fHotCtl ); - end; - Applet.fHotCtl.RefDec; + {$IFDEF USE_FLAGS} + exclude( Applet.DF.fHotCtl.fFlagsG4, G4_Hot ); + {$ELSE} Applet.DF.fHotCtl.fHot := FALSE; {$ENDIF} + if {$IFDEF USE_FLAGS} (G6_GraphicCtl in Applet.DF.fHotCtl.fFlagsG6) + {$ELSE} not Applet.fHotCtl.fWindowed {$ENDIF} then + begin + Applet.DF.fHotCtl.Invalidate; + {$IFDEF NIL_EVENTS} + if Assigned( Applet.DF.fHotCtl.EV.fOnMouseLeave ) then + {$ENDIF} + Applet.DF.fHotCtl.EV.fOnMouseLeave( Applet.DF.fHotCtl ); + end; + Applet.DF.fHotCtl.RefDec; end; C.RefInc; - Applet.fHotCtl := C; - C.fHot := TRUE; + Applet.DF.fHotCtl := C; + {$IFDEF USE_FLAGS} include( C.fFlagsG4, G4_Hot ); + {$ELSE} C.fHot := TRUE; {$ENDIF} C.Invalidate; - Self_.fMouseLeaveProc := Self_.MouseLeaveFromParentOfGraphCtl; + Self_.EV.fMouseLeaveProc := Self_.MouseLeaveFromParentOfGraphCtl; ProvideMouseEnterLeave( Self_ ); - if Assigned( C.OnMouseEnter ) then - C.OnMouseEnter( C ); + {$IFDEF NIL_EVENTS} + if Assigned( C.EV.fOnMouseEnter ) then + {$ENDIF} + C.EV.fOnMouseEnter( C ); end; {$ENDIF GRAPHCTL_HOTTRACK} - if C.fWindowed then + if {$IFDEF USE_FLAGS} not(G6_GraphicCtl in C.fFlagsG6) + {$ELSE} C.fWindowed {$ENDIF} then begin - Msg.hwnd := C.fHandle; - Pt := Self_.Client2Screen( Pt ); - Pt := C.Screen2Client( Pt ); - Msg.lParam := Pt.Y shl 16 or (Pt.X and $FFFF); + Msg.hwnd := C.fHandle; + Pt := Self_.Client2Screen( Pt ); + Pt := C.Screen2Client( Pt ); + Msg.lParam := Pt.Y shl 16 or (Pt.X and $FFFF); end; Rslt := C.WndProc( Msg ); - if not C.fWindowed then - if Assigned( C.fGraphCtlMouseEvent ) then - C.fGraphCtlMouseEvent( Msg ) + if {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6) + {$ELSE} not C.fWindowed {$ENDIF} then + {$IFDEF NIL_EVENTS} + if Assigned( C.EV.fGraphCtlMouseEvent ) then + {$ENDIF} + C.EV.fGraphCtlMouseEvent( Msg ) else if (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_RBUTTONDOWN) or @@ -61604,11 +60750,13 @@ begin {$IFDEF GRAPHCTL_HOTTRACK} Self_.MouseLeaveFromParentOfGraphCtl( Self_ ); {$ENDIF GRAPHCTL_HOTTRACK} - if Self_.fIsGroupBox and ( + if {$IFDEF USE_FLAGS} (G5_IsGroupbox in Self_.fFlagsG5) + {$ELSE} Self_.fIsGroupBox {$ENDIF} + and ( (Msg.message = WM_LBUTTONDOWN) or (Msg.message = WM_LBUTTONDBLCLK) or (Msg.message = WM_LBUTTONUP) - ) then + ) then begin Self_.Invalidate; end; @@ -61627,25 +60775,29 @@ begin PF := Self_.ParentForm else PF := Self_; - if (PF.fCurrentControl <> nil) and not PF.fCurrentControl.fWindowed then + if (PF.DF.fCurrentControl <> nil) + and {$IFDEF USE_FLAGS} (G6_GraphicCtl in PF.DF.fCurrentControl.fFlagsG6) + {$ELSE} not PF.DF.fCurrentControl.fWindowed {$ENDIF} then begin - if Assigned( PF.fCurrentControl.fKeyboardProcess ) and - PF.fCurrentControl.fKeyboardProcess( Msg, Rslt ) then + if Assigned( PF.DF.fCurrentControl.fKeyboardProcess ) and + PF.DF.fCurrentControl.fKeyboardProcess( Msg, Rslt ) then else - Rslt := PF.fCurrentControl.WndProc( Msg ); + Rslt := PF.DF.fCurrentControl.WndProc( Msg ); Result := TRUE; end else begin - if Self_.fIsGroupBox and (Msg.wParam = WORD( ' ' )) and - ( + if {$IFDEF USE_FLAGS} (G5_IsGroupbox in Self_.fFlagsG5) + {$ELSE} Self_.fIsGroupBox {$ENDIF} + and (Msg.wParam = WORD( ' ' )) and + ( (Msg.message = WM_KEYDOWN) or (Msg.message = WM_SYSKEYDOWN) or (Msg.message = WM_KEYUP) or (Msg.message = WM_SYSKEYUP) or (Msg.message = WM_CHAR) or (Msg.message = WM_SYSCHAR) - ) then + ) then begin Self_.Invalidate; end; @@ -61662,19 +60814,22 @@ begin begin C := Pointer( Msg.wParam ); PF := C.ParentForm; - if (PF.fCurrentControl <> nil) and (PF.fCurrentControl <> C) then + if (PF.DF.fCurrentControl <> nil) and (PF.DF.fCurrentControl <> C) then begin - PF.fCurrentControl.fFocused := FALSE; - PF.fCurrentControl.Invalidate; + {$IFDEF USE_FLAGS} + exclude( PF.DF.fCurrentControl.fFlagsG2, G2_Focused ); + {$ELSE} PF.DF.fCurrentControl.fFocused := FALSE; {$ENDIF} + PF.DF.fCurrentControl.Invalidate; end; - PF.fCurrentControl := C; - C.Parent.fCurrentControl := C; - C.Parent.fFocusHandle := C.Parent.fHandle; - C.fFocused := TRUE; - if Assigned( C.fOnEnter ) then - C.fOnEnter( C ); + PF.DF.fCurrentControl := C; + C.Parent.DF.fCurrentControl := C; + //C.Parent.fFocusHandle := C.Parent.fHandle; + {$IFDEF USE_FLAGS} include( C.fFlagsG2, G2_Focused ); + {$ELSE} C.fFocused := TRUE; {$ENDIF} + if Assigned( C.EV.fOnEnter ) then + C.EV.fOnEnter( C ); C.Invalidate; - C.fLeave := C.LeaveGraphButton; + C.EV.fLeave := C.LeaveGraphButton; C.RefDec; end; end; @@ -61685,13 +60840,15 @@ begin Result := FALSE; if Msg.message = WM_ACTIVATE then begin - if Self_.fCurrentControl <> nil then - Self_.fCurrentControl.Invalidate; + if Self_.DF.fCurrentControl <> nil then + Self_.DF.fCurrentControl.Invalidate; end else if (Msg.message >= WM_KEYFIRST) and (Msg.message <= WM_KEYLAST) then begin - if (Self_.fCurrentControl <> nil) and not Self_.fCurrentControl.fWindowed then + if (Self_.DF.fCurrentControl <> nil) + and {$IFDEF USE_FLAGS} (G6_GraphicCtl in Self_.DF.fCurrentControl.fFlagsG6) + {$ELSE} not Self_.fCurrentControl.fWindowed {$ENDIF} then begin if (Msg.message = WM_KEYDOWN) and ((Msg.wParam = 32) or (Msg.wParam = 13)) then begin @@ -61706,10 +60863,10 @@ begin (Msg2.wParam <> Msg.wParam) then Msg.message := WM_SYSCHAR; end; - if Assigned( Self_.fCurrentControl.fKeyboardProcess ) and - Self_.fCurrentControl.fKeyboardProcess( Msg, Rslt ) then + if Assigned( Self_.DF.fCurrentControl.fKeyboardProcess ) and + Self_.DF.fCurrentControl.fKeyboardProcess( Msg, Rslt ) then else - Rslt := Self_.fCurrentControl.WndProc( Msg ); + Rslt := Self_.DF.fCurrentControl.WndProc( Msg ); Result := TRUE; end; end; @@ -61723,84 +60880,117 @@ begin if AppletTerminated then Exit; GetCursorPos( Pt ); Pt := Screen2Client( Pt ); - if (Applet.fHotCtl <> nil) and (fChildren.IndexOf( Applet.fHotCtl ) >= 0) then + if (Applet.DF.fHotCtl <> nil) and (fChildren.IndexOf( Applet.DF.fHotCtl ) >= 0) then begin - C := Applet.fHotCtl; - if PtInRect( C.BoundsRect, Pt ) then Exit; - Applet.fHotCtl := nil; - C.fHot := FALSE; - if not C.fWindowed then - C.Invalidate; - if Assigned( C.OnMouseLeave ) then - C.OnMouseLeave( C ); - C.RefDec; + C := Applet.DF.fHotCtl; + if PtInRect( C.BoundsRect, Pt ) then Exit; + Applet.DF.fHotCtl := nil; + {$IFDEF USE_FLAGS} exclude( C.fFlagsG4, G4_Hot ); + {$ELSE} C.fHot := FALSE; {$ENDIF} + if {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6) + {$ELSE} not C.fWindowed {$ENDIF} then + C.Invalidate; + if Assigned( C.OnMouseLeave ) then + C.OnMouseLeave( C ); + C.RefDec; end; end; {$ENDIF GRAPHCTL_HOTTRACK} procedure NotifyGraphCtlAboutNewParent(Prnt, Chld: PControl); begin - if (Chld <> nil) and (Prnt <> nil) then - begin - Prnt.AttachProc( WndProc_ParentOfGraphicCtl ); - {if not Prnt.IsProcAttached( WndProc_ParentOfGraphicCtl ) then - begin - Prnt.fDynHandlers.Insert( 0, nil ); - Prnt.fDynHandlers.Insert( 0, @ WndProc_ParentOfGraphicCtl ); - end;} - end; + if (Chld <> nil) and (Prnt <> nil) then + Prnt.AttachProc( WndProc_ParentOfGraphicCtl ); end; -function _NewGraphCtl( AParent: PControl; ATabStop: Boolean ): PControl; +function _NewGraphCtl( AParent: PControl; ATabStop: Boolean; + ACommandActions: TCommandActionsParam ): PControl; +var IdxActions: Integer; begin - {-} new( Result, Create ); - {+}{++}(*Result := PControl.CreateParented( AParent );*){--} - Result.fDoInvalidate := Result.InvalidateNonWindowed; - Result.fWindowed := FALSE; - Result.fVisible := TRUE; - Result.fCreateVisible := TRUE; - Result.fIsControl := TRUE; + {$IFDEF DEBUG_OBJKIND} + Result.fObjKind := 'TControl:GraphicControl'; + {$ENDIF} + {$IFDEF COMMANDACTIONS_OBJ} + IdxActions := Integer( ACommandActions ); + if IdxActions >= 120 then + IdxActions := PByte( ACommandActions )^; + if AllActions_Objs[IdxActions] <> nil then + begin + Result.fCommandActions := AllActions_Objs[IdxActions]; + Result.fCommandActions.RefInc; + end + else + begin + new( Result.fCommandActions, Create ); + {$IFDEF DEBUG_OBJKIND} + Result.fCommandActions.fObjKind := 'TCommandActionsObj'; + {$ENDIF} + AllActions_Objs[IdxActions] := Result.fCommandActions; + {$IFDEF SAFE_CODE} + if ACommandActions <> nil then + {$ENDIF} + Move( ACommandActions^, Result.fCommandActions.aClear, Sizeof( TCommandActions ) ); + end; + Result.Add2AutoFree( Result.fCommandActions ); + {$ELSE} + {$IFDEF SAFE_CODE} + if ACommandActions <> nil then + {$ENDIF} + Result.fCommandActions := ACommandActions^; + {$ENDIF} + Result.PP.fDoInvalidate := InvalidateNonWindowed; + {$IFDEF USE_FLAGS} include( Result.fFlagsG6, G6_GraphicCtl ); + {$ELSE} Result.fWindowed := FALSE; {$ENDIF} + {$IFDEF USE_FLAGS} + include( Result.fFlagsG3, G3_IsControl ); + include( Result.fFlagsG4, G4_CreateVisible ); + if ATabStop then + include( Result.fStyle.f2_Style, F2_TabStop ); + {$ELSE} Result.fCreateVisible := TRUE; + Result.fVisible := TRUE; + Result.fIsControl := TRUE; + Result.fTabstop := ATabStop; + {$ENDIF} Result.fMenu := CtlIdCount; Inc( CtlIdCount ); - Result.fBitBtnOptions := [ bboFixed ]; // to return Checked = fChecked w/o window handle - Result.fIgnoreWndCaption := TRUE; - Result.fNotifyChild := @ NotifyGraphCtlAboutNewParent; - Result.fSizeRedraw := TRUE; - Result.fTabstop := ATabStop; - if ATabStop then - Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ]; - if AParent <> nil then + Result.DF.fBitBtnOptions := [ bboFixed ]; // to return Checked = fChecked w/o window handle + {$IFDEF USE_FLAGS} + Result.fFlagsG1 := Result.fFlagsG1 + [ G1_IgnoreWndCaption, G1_SizeRedraw ]; + {$ELSE} Result.fIgnoreWndCaption := TRUE; + Result.fSizeRedraw := TRUE; + {$ENDIF} + Result.PP.fNotifyChild := @ NotifyGraphCtlAboutNewParent; + if ATabStop then + Result.fLookTabKeys := [ tkTab, tkLeftRight, tkUpDown, tkPageUpPageDn ]; + if AParent <> nil then begin - Result.Parent := AParent; - Result.Border := AParent.Border; - //if not AParent.IsProcAttached( WndProc_ParentOfGraphicCtl ) then - begin + Result.Parent := AParent; + Result.Border := AParent.Border; AParent.AttachProc( WndProc_ParentOfGraphicCtl ); - //AParent.fDynHandlers.Insert( 0, nil ); - //AParent.fDynHandlers.Insert( 0, @ WndProc_ParentOfGraphicCtl ); - end; - if ATabStop then - begin - Inc( AParent.ParentForm.fTabOrder ); - Result.fTabOrder := AParent.ParentForm.fTabOrder; - end; - if AParent.IsControl then - AParent.ParentForm.AttachProc( WndProc_FormHavingGraphCtl ); - if AParent.fIsGroupBox then - begin - AParent.Style := AParent.Style and - not BS_GROUPBOX; // otherwise the groupbox is flickering A LOT! - AParent.Parent.AttachProc( WndProc_ParentOfGraphicCtl ); - end; + if ATabStop then + begin + Inc( AParent.ParentForm.fTabOrder ); + Result.fTabOrder := AParent.ParentForm.fTabOrder; + end; + if {$IFDEF USE_FLAGS} G3_IsControl in AParent.fFlagsG3 + {$ELSE} AParent.fIsControl {$ENDIF} then + AParent.ParentForm.AttachProc( WndProc_FormHavingGraphCtl ); + if {$IFDEF USE_FLAGS} G5_IsGroupbox in APArent.fFlagsG5 + {$ELSE} AParent.fIsGroupBox {$ENDIF} then + begin + AParent.Style := AParent.Style and + not BS_GROUPBOX; // otherwise the groupbox is flickering A LOT! + AParent.Parent.AttachProc( WndProc_ParentOfGraphicCtl ); + end; - Result.fFont := Result.fFont.Assign( AParent.fFont ); - if Result.fFont <> nil then - begin - Result.fFont.fParentGDITool := AParent.fFont; - Result.fFont.fOnChange := Result.FontChanged; - Result.FontChanged( Result.fFont ); - end; + Result.fFont := Result.fFont.Assign( AParent.fFont ); + if Result.fFont <> nil then + begin + Result.fFont.fParentGDITool := AParent.fFont; + Result.fFont.fOnChange := Result.FontChanged; + Result.FontChanged( Result.fFont ); + end; end; Result.fBoundsRect.Right := Result.fBoundsRect.Left + 64; Result.fBoundsRect.Bottom := Result.fBoundsRect.Top + 22; @@ -61816,9 +61006,12 @@ begin {$IFDEF INPACKAGE} Result := NewLabel( AParent, ACaption ); {$ELSE} - Result := _NewGraphCtl( AParent, FALSE ); - Result.fCommandActions := LabelActions; - Result.fPaintProc := Result.GraphicLabelPaint; + Result := _NewGraphCtl( AParent, FALSE, + {$IFDEF PACK_COMMANDACTIONS} LabelActions_Packed + {$ELSE} @LabelActions {$ENDIF} ); + Result.aAutoSzX := 1; + Result.aAutoSzY := 1; + Result.EV.fPaintProc := Result.GraphicLabelPaint; Result.Caption := ACaption; {$ENDIF} end; @@ -61826,10 +61019,11 @@ end; function NewWordWrapGraphLabel( AParent: PControl; const ACaption: KOLString ): PControl; begin {$IFDEF INPACKAGE} - Result := NewWordWrapLabel( AParent, ACaption ); + Result := NewWordWrapLabel( AParent, ACaption ); {$ELSE} - Result := NewGraphLabel( AParent, ACaption ); - Result.fWordWrap := TRUE; + Result := NewGraphLabel( AParent, ACaption ); + {$IFDEF USE_FLAGS} include( Result.fFlagsG1, G1_WordWrap ); + {$ELSE} Result.fWordWrap := TRUE; {$ENDIF} {$ENDIF} end; @@ -61846,14 +61040,18 @@ procedure ClickGraphCheck(Sender: PObj); var Ctl: PControl; begin Ctl := Pointer( Sender ); - if not Ctl.Enabled then Exit; + if not Ctl.Enabled then Exit; Ctl.Focused := TRUE; - if Assigned( Ctl.OnEnter ) then - Ctl.OnEnter( Ctl ); - Ctl.fChecked := not Ctl.fChecked; + if Assigned( Ctl.OnEnter ) then + Ctl.OnEnter( Ctl ); + {$IFDEF USE_FLAGS} + if G4_Checked in Ctl.fFlagsG4 then + exclude( Ctl.fFlagsG4, G4_Checked ) + else include( Ctl.fFlagsG4, G4_Checked ); + {$ELSE} Ctl.fChecked := not Ctl.fChecked; {$ENDIF} Ctl.Invalidate; - if Assigned( Ctl.OnClick ) then - Ctl.OnClick( Ctl ); + if Assigned( Ctl.OnClick ) then + Ctl.OnClick( Ctl ); end; function NewGraphCheckBox( AParent: PControl; const ACaption: KOLString ): PControl; @@ -61863,10 +61061,10 @@ begin {$ELSE} Result := NewGraphButton( AParent, ACaption ); Result.TextAlign := taLeft; - Result.fCommandActions.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4; - Result.fPaintProc := Result.GraphicCheckBoxPaint; - Result.fGraphCtlMouseEvent := Result.GraphicCheckBoxMouse; - Result.fControlClick := @ ClickGraphCheck; + Result.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4; + Result.EV.fPaintProc := Result.GraphicCheckBoxPaint; + Result.EV.fGraphCtlMouseEvent := Result.GraphicCheckBoxMouse; + Result.PP.fControlClick := @ ClickGraphCheck; {$ENDIF} end; @@ -61882,7 +61080,7 @@ begin for i := 0 to Ctl.Parent.ChildCount-1 do begin C := Ctl.Parent.Children[ i ]; - if (C <> Ctl) and (@ C.fControlClick = @ ClickGraphRadio) then + if (C <> Ctl) and (@ C.PP.fControlClick = @ ClickGraphRadio) then C.Checked := FALSE; end; end; @@ -61895,53 +61093,126 @@ begin {$ELSE} Result := NewGraphButton( AParent, ACaption ); Result.TextAlign := taLeft; - Result.fCommandActions.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4; - Result.fPaintProc := Result.GraphicRadioBoxPaint; - Result.fControlClick := @ ClickGraphRadio; + Result.aAutoSzX := GetSystemMetrics( SM_CXMENUCHECK ) + 4; + Result.EV.fPaintProc := Result.GraphicRadioBoxPaint; + Result.PP.fControlClick := @ ClickGraphRadio; if AParent <> nil then begin - AParent.fRadioLast := Result.fMenu; - if AParent.fRadio1st = 0 then + //AParent.fRadioLast := Result.fMenu; + AParent.PropInt[ RADIO_LAST ] := Result.fMenu; + //if AParent.fRadio1st = 0 then + if AParent.PropInt[ RADIO_1ST ] = 0 then begin - AParent.fRadio1st := Result.fMenu; - Result.SetRadioChecked; + //AParent.fRadio1st := Result.fMenu; + AParent.PropInt[ RADIO_1ST ] := Result.fMenu; + Result.SetRadioChecked; end; end; {$ENDIF} end; +procedure GraphButtonSetFocus(Ctl: PControl); +var PF, CC: PControl; + W: HWnd; +begin + if {$IFDEF USE_FLAGS} not(F2_Tabstop in Ctl.fStyle.f2_Style) + {$ELSE} not Ctl.fTabStop {$ENDIF} then Exit; + PF := Ctl.ParentForm; + if (PF.DF.fCurrentControl <> nil) and (PF.DF.fCurrentControl <> Ctl) and + (PF.DF.fCurrentControl <> Ctl.fParent) then + begin + CC := PF.DF.fCurrentControl; + CC.RefInc; + Ctl.fParent.Focused := TRUE; + if Assigned( CC.EV.fLeave ) then + CC.EV.fLeave( PF.DF.fCurrentControl ) + else + Windows.SetFocus( 0 ); + CC.RefDec; + end else + begin + W := GetFocus; + if (W <> Ctl.Parent.fHandle) and (W <> 0) then + begin + Windows.SetFocus( 0 ); + Ctl.fParent.Focused := TRUE; + end; + end; + if Ctl.fParent.fHandle <> 0 then + begin + {$IFDEF USE_FLAGS} include( Ctl.fFlagsG2, G2_Focused ); + {$ELSE} Ctl.fFocused := TRUE; {$ENDIF} + Ctl.fParent.Postmsg( CM_FOCUSGRAPHCTL, Integer( Ctl ), 0 ); + Ctl.RefInc; + end; + if Assigned( Ctl.EV.fOnEnter ) then + Ctl.EV.fOnEnter( Ctl ); +end; + function NewGraphButton( AParent: PControl; const ACaption: KOLString ): PControl; begin {$IFDEF INPACKAGE} Result := NewButton( AParent, ACaption ); {$ELSE} - Result := _NewGraphCtl( AParent, TRUE ); - Result.fCommandActions := ButtonActions; - Result.fPaintProc := Result.GraphicButtonPaint; + Result := _NewGraphCtl( AParent, TRUE, + {$IFDEF PACK_COMMANDACTIONS} ButtonActions_Packed + {$ELSE} @ButtonActions {$ENDIF} ); + Result.EV.fPaintProc := Result.GraphicButtonPaint; Result.Caption := ACaption; Result.TextAlign := taCenter; Result.VerticalAlign := vaCenter; - Result.fGraphCtlMouseEvent := Result.GraphicButtonMouse; - Result.fSetFocus := Result.GraphButtonSetFocus; + Result.EV.fGraphCtlMouseEvent := Result.GraphicButtonMouse; + Result.fSetFocus := @GraphButtonSetFocus; Result.fKeyboardProcess := Result.GraphButtonKeyboardProcess; {$ENDIF} end; +function EditGraphEdit(Ctl: PControl): PControl; +var E: PControl; +begin + E := NewEditBox( Ctl.fParent, Ctl.DF.fEditOptions ); + E.SetBoundsRect( Ctl.BoundsRect ); + E.SetAlign( Ctl.Align ); + E.fTabOrder := Ctl.fTabOrder; + E.Text := Ctl.Text; + E.OnChange := Ctl.ChangeGraphEdit; + E.Color := Ctl.Color; + E.fCursor := Ctl.fCursor; + E.CreateWindow; + E.OnLeave := Ctl.LeaveGraphEdit; + E.EV.fLeave := Ctl.LeaveGraphEdit; + E.Focused := TRUE; + E.OnChar := Ctl.OnChar; + E.OnKeyDown := Ctl.OnKeyDown; + E.OnKeyUp := Ctl.OnKeyUp; + E.OnDestroy := Ctl.DestroyGraphEdit; + //E.Font.Assign( Font ); + Result := E; + Ctl.Visible := FALSE; + Ctl.DF.fEditCtl := E; + {$IFDEF NIL_EVENTS} + if Assigned( Ctl.EV.fOnEnter ) then + {$ENDIF} + Ctl.EV.fOnEnter( Ctl ); +end; + function NewGraphEditbox( AParent: PControl; Options: TEditOptions ): PControl; begin {$IFDEF INPACKAGE} Result := NewEditbox( AParent, Options ); {$ELSE} - Result := _NewGraphCtl( AParent, TRUE ); - Result.fCommandActions := EditActions; - Result.fPaintProc := Result.GraphicEditPaint; - Result.fEditOptions := Options; + Result := _NewGraphCtl( AParent, TRUE, + {$IFDEF PACK_COMMANDACTIONS} EditActions_Packed + {$ELSE} @EditActions {$ENDIF} ); + Result.aAutoSzY := 1; + Result.EV.fPaintProc := Result.GraphicEditPaint; + Result.DF.fEditOptions := Options; Result.VerticalAlign := vaCenter; Result.fColor := clWindow; - Result.fGraphCtlMouseEvent := Result.GraphicEditMouse; - Result.fSetFocus := Result.GraphEditBoxSetFocus; + Result.EV.fGraphCtlMouseEvent := Result.GraphicEditMouse; + Result.fSetFocus := @EditGraphEdit; Result.fLookTabKeys := [ tkTab, tkUpDown, tkPageUpPageDn ]; - Result.fLeave := Result.LeaveGraphEdit; + Result.EV.fLeave := Result.LeaveGraphEdit; {$ENDIF} end; @@ -61950,12 +61221,12 @@ end; function TControl.DoGraphCtlPrepaint: TRect; begin Result := ClientRect; - if not Assigned( OnPrepaint ) and not Transparent then + if not Assigned( EV.fOnPrepaint ) and not Transparent then begin - if Assigned( fBrush ) then - Canvas.Brush.Assign( fBrush ) + if fBrush <> nil then + Canvas.Brush.Assign( fBrush ) else - Canvas.Brush.Color := Color; + Canvas.Brush.Color := Color; Canvas.FillRect( Result ); end; end; @@ -61979,23 +61250,12 @@ var R, R1: TRect; {$ENDIF} begin R := DoGraphCtlPrepaint; - { - R := ClientRect; - if not Assigned( OnPrepaint ) and not Transparent then - begin - if Assigned( fBrush ) then - Canvas.Brush.Assign( fBrush ) - else - Canvas.Brush.Color := Color; - Canvas.FillRect( R ); - end; - } {$IFDEF GRAPHCTL_XPSTYLES} OpenThemeDataProc; Theme := 0; - if Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then - Theme := fOpenThemeDataProc( 0, 'Button' ); + if Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then + Theme := fOpenThemeDataProc( 0, 'Button' ); if Theme <> 0 then begin @@ -62004,20 +61264,23 @@ begin R1 := R; R1.Right := R1.Left + W; - if fWordWrap then - R1.Top := R1.Top + Border + if {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1 + {$ELSE} fWordWrap {$ENDIF} then + R1.Top := R1.Top + Border else - R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2; + R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2; R1.Bottom := R1.Top + H; Flag := 1; {CBS_UNCHECKEDNORMAL} if not Enabled then Flag := 4 {CBS_UNCHECKEDDISABLED} else - if fHot then - Flag := 2; {CBS_UNCHECKEDHOT} - if fChecked then - Inc( Flag, 4 ); + if {$IFDEF USE_FLAGS} G4_Hot in fFlagsG4 + {$ELSE} fHot {$ENDIF} then + Flag := 2; {CBS_UNCHECKEDHOT} + if {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4 + {$ELSE} fChecked {$ENDIF} then + Inc( Flag, 4 ); fDrawThemeBackground( Theme, DC, 3 {BP_CHECKBOX}, Flag, @R1, @R ); R.Left := R1.Left + W + Border; @@ -62025,15 +61288,16 @@ begin if fCaption <> '' then begin DrawFormattedText( @ Self, DC, R, DT_CALCRECT ); - if fWordWrap then + if {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1 + {$ELSE} fWordWrap {$ENDIF} then begin - DrawFormattedText( @ Self, DC, R, 0 ); - GraphCtlDrawFocusRect( DC, R ); + DrawFormattedText( @ Self, DC, R, 0 ); + GraphCtlDrawFocusRect( DC, R ); end else begin - GraphCtlDrawFocusRect( DC, R ); - DrawFormattedTextXP( Theme, @ Self, DC, R, 3 {BP_CHECKBOX}, Flag, 0, 0 ); + GraphCtlDrawFocusRect( DC, R ); + DrawFormattedTextXP( Theme, @ Self, DC, R, 3 {BP_CHECKBOX}, Flag, 0, 0 ); end; end; @@ -62048,19 +61312,18 @@ begin R1 := R; R1.Right := R1.Left + W; - if fWordWrap then - R1.Top := R1.Top + Border + if {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1 + {$ELSE} fWordWrap {$ENDIF} then + R1.Top := R1.Top + Border else - R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2; + R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2; R1.Bottom := R1.Top + H; - //if not Transparent then - begin - Flag := 0; - if fChecked then + Flag := 0; + if {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4 + {$ELSE} fChecked {$ENDIF} then Flag := DFCS_CHECKED; - DrawFrameControl( DC, R1, DFC_BUTTON, DFCS_BUTTONCHECK or - $800 {DFCS_TRANSPARENT} or Flag ); - end; + DrawFrameControl( DC, R1, DFC_BUTTON, DFCS_BUTTONCHECK or + $800 {DFCS_TRANSPARENT} or Flag ); R.Left := R1.Left + W + Border; DrawFormattedText( @ Self, DC, R, 0 ); @@ -62083,15 +61346,12 @@ var R, R1: TRect; {$ENDIF} begin R := DoGraphCtlPrepaint; - {R := ClientRect; - if not Assigned( OnPrepaint ) and not Transparent then - Canvas.FillRect( R );} {$IFDEF GRAPHCTL_XPSTYLES} OpenThemeDataProc; Theme := 0; - if Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then - Theme := fOpenThemeDataProc( 0, 'Button' ); - if Theme <> 0 then + if Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then + Theme := fOpenThemeDataProc( 0, 'Button' ); + if Theme <> 0 then begin W := GetSystemMetrics( SM_CXMENUCHECK ); @@ -62099,20 +61359,23 @@ begin R1 := R; R1.Right := R1.Left + W; - if fWordWrap then - R1.Top := R1.Top + Border + if {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1 + {$ELSE} fWordWrap {$ENDIF} then + R1.Top := R1.Top + Border else - R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2; + R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2; R1.Bottom := R1.Top + H; Flag := 1; {CBS_UNCHECKEDNORMAL} if not Enabled then Flag := 4 {CBS_UNCHECKEDDISABLED} else - if fHot then - Flag := 2; {CBS_UNCHECKEDHOT} - if fChecked then - Inc( Flag, 4 ); + if {$IFDEF USE_FLAGS} G4_Hot in fFlagsG4 + {$ELSE} fHot {$ENDIF} then + Flag := 2; {CBS_UNCHECKEDHOT} + if {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4 + {$ELSE} fChecked {$ENDIF} then + Inc( Flag, 4 ); fDrawThemeBackground( Theme, DC, 2 {BP_RADIOBOX}, Flag, @R1, @R ); R.Left := R1.Left + W + Border; @@ -62120,15 +61383,15 @@ begin if fCaption <> '' then begin DrawFormattedText( @ Self, DC, R, DT_CALCRECT ); - if fWordWrap then + if {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1 + {$ELSE} fWordWrap {$ENDIF} then begin - DrawFormattedText( @ Self, DC, R, 0 ); - GraphCtlDrawFocusRect( DC, R ); - end - else + DrawFormattedText( @ Self, DC, R, 0 ); + GraphCtlDrawFocusRect( DC, R ); + end else begin - GraphCtlDrawFocusRect( DC, R ); - DrawFormattedTextXP( Theme, @ Self, DC, R, 2 {BP_RADIOBOX}, Flag, 0, 0 ); + GraphCtlDrawFocusRect( DC, R ); + DrawFormattedTextXP( Theme, @ Self, DC, R, 2 {BP_RADIOBOX}, Flag, 0, 0 ); end; end; fCloseThemeData( Theme ); @@ -62140,19 +61403,18 @@ begin H := GetSystemMetrics( SM_CYMENUCHECK ); R1 := R; R1.Right := R1.Left + W; - if fWordWrap then - R1.Top := R1.Top + Border + if {$IFDEF USE_FLAGS} G1_WordWrap in fFlagsG1 + {$ELSE} fWordWrap {$ENDIF} then + R1.Top := R1.Top + Border else - R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2; + R1.Top := R1.Top + (R1.Bottom - R1.Top - H) div 2; R1.Bottom := R1.Top + H; - //if not Transparent then - begin - Flag := 0; - if fChecked then + Flag := 0; + if {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4 + {$ELSE} fChecked {$ENDIF} then Flag := DFCS_CHECKED; - DrawFrameControl( DC, R1, DFC_BUTTON, DFCS_BUTTONRADIO - or $800 {DFCS_TRANSPARENT} {or DFCS_ADJUSTRECT} or Flag ); - end; + DrawFrameControl( DC, R1, DFC_BUTTON, DFCS_BUTTONRADIO + or $800 {DFCS_TRANSPARENT} {or DFCS_ADJUSTRECT} or Flag ); R.Left := R1.Right + 2; DrawFormattedText( @ Self, DC, R, 0 ); GraphCtlDrawFocusRect( DC, R ); @@ -62180,23 +61442,26 @@ begin if Theme <> 0 then begin Flag := 1; {PBS_UNCHECKEDNORMAL} - if not Enabled then - Flag := 4 {PBS_UNCHECKEDDISABLED} + if not Enabled then + Flag := 4 {PBS_UNCHECKEDDISABLED} else - if fPushed then - Flag := 3 {PBS_UNCHECKEDPRESSED} + if {$IFDEF USE_FLAGS} G4_Pushed in fFlagsG4 + {$ELSE} fPushed {$ENDIF} then + Flag := 3 {PBS_UNCHECKEDPRESSED} else - if fHot then - Flag := 2; {PBS_UNCHECKEDHOT} - if fChecked then - Inc( Flag, 4 ); + if {$IFDEF USE_FLAGS} G4_Hot in fFlagsG4 + {$ELSE} fHot {$ENDIF} then + Flag := 2; {PBS_UNCHECKEDHOT} + if {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4 + {$ELSE} fChecked {$ENDIF} then + Inc( Flag, 4 ); fDrawThemeBackground( Theme, DC, 1 {BP_PUSHBUTTON}, Flag, @R, @R ); fGetThemeBackgroundContentRect( Theme, DC, 1 {BS_PUSHBUTTON}, Flag, @R, @R1 ); GraphCtlDrawFocusRect( DC, R1 ); - if (fButtonIcon <> 0) and GetIconInfo( fButtonIcon, II ) then + if (DF.fButtonIcon <> 0) and GetIconInfo( DF.fButtonIcon, II ) then begin if GetObject( II.hbmColor, Sizeof( BI ), @ BI ) <> 0 then begin @@ -62208,7 +61473,7 @@ begin else //vaCenter: Y := R.Top + (R.Bottom - R.Top - BI.bmHeight) div 2; END; - DrawIcon( DC, R.Left + Border, Y, fButtonIcon ); + DrawIcon( DC, R.Left + Border, Y, DF.fButtonIcon ); Inc( R1.Left, BI.bmWidth + Border * 2 ); end; DeleteObject( II.hbmColor ); @@ -62231,20 +61496,23 @@ begin {$ENDIF} begin Flag := 0; - if fChecked then - Flag := DFCS_CHECKED + if {$IFDEF USE_FLAGS} G4_Checked in fFlagsG4 + {$ELSE} fChecked {$ENDIF} then + Flag := DFCS_CHECKED else - if fPushed then - Flag := DFCS_PUSHED; - if fFlat then - Flag := Flag or DFCS_FLAT; + if {$IFDEF USE_FLAGS} G4_Pushed in fFlagsG4 + {$ELSE} fPushed {$ENDIF} then + Flag := DFCS_PUSHED; + if {$IFDEF USE_FLAGS} G3_Flat in fFlagsG3 + {$ELSE} fFlat {$ENDIF} then + Flag := Flag or DFCS_FLAT; DrawFrameControl( DC, R, DFC_BUTTON, DFCS_BUTTONPUSH or $800 {DFCS_TRANSPARENT} or DFCS_ADJUSTRECT or Flag ); //{$IFNDEF GRAPHCTL_XPSTYLES} R1 := R; //{$ENDIF} - if (fButtonIcon <> 0) and GetIconInfo( fButtonIcon, II ) then + if (DF.fButtonIcon <> 0) and GetIconInfo( DF.fButtonIcon, II ) then begin if GetObject( II.hbmColor, Sizeof( BI ), @ BI ) <> 0 then begin @@ -62256,7 +61524,7 @@ begin else //vaCenter: Y := R.Top + (R.Bottom - R.Top - BI.bmHeight) div 2; END; - DrawIcon( DC, R.Left + Border, Y, fButtonIcon ); + DrawIcon( DC, R.Left + Border, Y, DF.fButtonIcon ); Inc( R1.Left, BI.bmWidth + Border * 2 ); end; DeleteObject( II.hbmColor ); @@ -62275,79 +61543,47 @@ begin CASE Msg.message OF WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin - GraphButtonSetFocus; + GraphButtonSetFocus(@Self); RefInc; SetCapture( Parent.Handle ); Parent.fPushedBtn := @ Self; - fPushed := TRUE; + {$IFDEF USE_FLAGS} include( fFlagsG4, G4_Pushed ); + {$ELSE} fPushed := TRUE; {$ENDIF} Invalidate; end; WM_LBUTTONUP: begin ReleaseCapture; Invalidate; - if fPushed then + if {$IFDEF USE_FLAGS} G4_Pushed in fFlagsG4 + {$ELSE} fPushed {$ENDIF} then begin - Pt.X := SmallInt( LoWord( Msg.lParam ) ); - Pt.Y := SmallInt( HiWord( Msg.lParam ) ); - if PtInRect( ClientRect, Pt ) then - DoClick; - fPushed := FALSE; - Parent.fPushedBtn := nil; - RefDec; + Pt.X := SmallInt( LoWord( Msg.lParam ) ); + Pt.Y := SmallInt( HiWord( Msg.lParam ) ); + if PtInRect( ClientRect, Pt ) then + DoClick; + {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_Pushed ); + {$ELSE} fPushed := FALSE; {$ENDIF} + Parent.fPushedBtn := nil; + RefDec; end; end; END; end; -procedure TControl.GraphButtonSetFocus; -var PF: PControl; - CC: PControl; - W: HWnd; -begin - if not fTabStop then Exit; - PF := ParentForm; - if (PF.fCurrentControl <> nil) and (PF.fCurrentControl <> @ Self) and - (PF.fCurrentControl <> Parent) then - begin - CC := PF.fCurrentControl; - CC.RefInc; - Parent.Focused := TRUE; - if Assigned( CC.fLeave ) then - CC.fLeave( PF.fCurrentControl ) - else - Windows.SetFocus( 0 ); - CC.RefDec; - end - else - begin - W := GetFocus; - if (W <> Parent.fHandle) and (W <> 0) then - begin - Windows.SetFocus( 0 ); - Parent.Focused := TRUE; - end; - end; - if Parent.fHandle <> 0 then - begin - fFocused := TRUE; - Parent.Postmsg( CM_FOCUSGRAPHCTL, Integer( @ Self ), 0 ); - RefInc; - end; - if Assigned( fOnEnter ) then - fOnEnter( @ Self ); -end; - procedure TControl.LeaveGraphButton( Sender: PObj ); begin - fFocused := FALSE; - if Parent.fCurrentControl = @ Self then - Parent.fCurrentControl := nil; - if ParentForm.fCurrentControl = @ Self then - ParentForm.fCurrentControl := nil; - Invalidate; - if Assigned( fOnLeave ) then - fOnLeave( @ Self ); + {$IFDEF USE_FLAGS} exclude( fFlagsG2, G2_Focused ); + {$ELSE} fFocused := FALSE; {$ENDIF} + if Parent.DF.fCurrentControl = @ Self then + Parent.DF.fCurrentControl := nil; + if ParentForm.DF.fCurrentControl = @ Self then + ParentForm.DF.fCurrentControl := nil; + Invalidate; + {$IFDEF NIL_EVENTS} + if Assigned( EV.fOnLeave ) then + {$ENDIF} + EV.fOnLeave( @ Self ); end; function TControl.GraphButtonKeyboardProcess(var Msg: TMsg; @@ -62360,20 +61596,22 @@ begin SpacePressed := SpacePressed or (Msg.wParam = 13); {$ENDIF} if not SpacePressed then Exit; - if (Msg.message = WM_KEYDOWN) or (Msg.message = WM_SYSKEYDOWN) then + if (Msg.message = WM_KEYDOWN) or (Msg.message = WM_SYSKEYDOWN) then begin - Parent.fPushedBtn := @ Self; - fPushed := TRUE; - Invalidate; - Result := TRUE; ///// + Parent.fPushedBtn := @ Self; + {$IFDEF USE_FLAGS} include( fFlagsG4, G4_Pushed ); + {$ELSE} fPushed := TRUE; {$ENDIF} + Invalidate; + Result := TRUE; ///// end else - if (Msg.message = WM_KEYUP) or (Msg.message = WM_SYSKEYUP) then + if (Msg.message = WM_KEYUP) or (Msg.message = WM_SYSKEYUP) then begin - fPushed := FALSE; - Parent.fPushedBtn := nil; - Invalidate; - Result := TRUE; ///// + {$IFDEF USE_FLAGS} exclude( fFlagsG4, G4_Pushed ); + {$ELSE} fPushed := FALSE; {$ENDIF} + Parent.fPushedBtn := nil; + Invalidate; + Result := TRUE; ///// end else if (Msg.message = WM_CHAR) or (Msg.message = WM_SYSCHAR) then @@ -62395,22 +61633,24 @@ begin {$IFDEF GRAPHCTL_XPSTYLES} OpenThemeDataProc; Theme := 0; - if Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then - Theme := fOpenThemeDataProc( 0, 'Edit' ); - if Theme <> 0 then + if Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then + Theme := fOpenThemeDataProc( 0, 'Edit' ); + if Theme <> 0 then begin Flag := 1; {ETS_NORMAL} - if not Enabled then - Flag := 4 {ETS_DISABLED} + if not Enabled then + Flag := 4 {ETS_DISABLED} else - if eoReadonly in fEditOptions then - Flag := 6 {ETS_READONLY} + if eoReadonly in DF.fEditOptions then + Flag := 6 {ETS_READONLY} else - if fFocused then - Flag := 5 {ETS_FOCUSED} + if {$IFDEF USE_FLAGS} G2_Focused in fFlagsG2 + {$ELSE} fFocused {$ENDIF} then + Flag := 5 {ETS_FOCUSED} else - if fHot then - Flag := 2; {ETS_HOT} + if {$IFDEF USE_FLAGS} G4_Hot in fFlagsG4 + {$ELSE} fHot {$ENDIF} then + Flag := 2; {ETS_HOT} fDrawThemeBackground( Theme, DC, 1 {EP_EDITTEXT}, Flag, @R, @R ); @@ -62421,8 +61661,8 @@ begin if fCaption <> '' then begin Flag1 := DT_SINGLELINE; - if eoMultiline in fEditOptions then - Flag1 := DT_WORDBREAK; + if eoMultiline in DF.fEditOptions then + Flag1 := DT_WORDBREAK; CASE fTextAlign OF taCenter: Flag1 := Flag1 or DT_CENTER; taRight: Flag1 := Flag1 or DT_RIGHT; @@ -62441,10 +61681,10 @@ begin else {$ENDIF} begin - if not Assigned( OnPrepaint ) and not Transparent then + if not Assigned( EV.fOnPrepaint ) and not Transparent then begin - Canvas.Brush.Color := fColor; - Canvas.FillRect( R ); + Canvas.Brush.Color := fColor; + Canvas.FillRect( R ); end; DrawEdge( DC, R, BDR_SUNKENINNER or BDR_SUNKENOUTER, BF_ADJUST or BF_RECT ); @@ -62459,9 +61699,9 @@ var E: PControl; begin CASE Msg.message OF WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: - if not ( eoReadOnly in fEditOptions ) then + if not ( eoReadOnly in DF.fEditOptions ) then begin - E := EditGraphEdit; + E := EditGraphEdit(@Self); Pt.X := Smallint( LoWord( Msg.lParam ) ) - Left; Pt.Y := Smallint( HiWord( Msg.lParam ) ) - Top; PostMessage( E.Handle, Msg.message, Msg.wParam, @@ -62470,49 +61710,23 @@ begin END; end; -function TControl.EditGraphEdit: PControl; -var E: PControl; -begin - E := NewEditBox( Parent, fEditOptions ) - .SetPosition( Left, Top ) - .SetSize( Width, Height ) - .SetAlign( Align ); - E.fTabOrder := fTabOrder; - E.Text := Text; - E.OnChange := ChangeGraphEdit; - E.Color := Color; - E.fCursor := fCursor; - E.CreateWindow; - E.OnLeave := LeaveGraphEdit; - E.fLeave := LeaveGraphEdit; - E.Focused := TRUE; - E.OnChar := OnChar; - E.OnKeyDown := OnKeyDown; - E.OnKeyUp := OnKeyUp; - E.OnDestroy := DestroyGraphEdit; - //E.Font.Assign( Font ); - Result := E; - Visible := FALSE; - fEditCtl := E; - if Assigned( fOnEnter ) then - fOnEnter( @ Self ); -end; - procedure TControl.LeaveGraphEdit(Sender: PObj); begin - if PControl( Sender ).fWindowed and Assigned( fEditCtl ) then + if {$IFDEF USE_FLAGS} not(G6_GraphicCtl in PControl(Sender).fFlagsG6) + {$ELSE} PControl( Sender ).fWindowed {$ENDIF} + and ( DF.fEditCtl <> nil ) then begin Text := PControl( Sender ).Text; - fEditCtl := nil; + DF.fEditCtl := nil; Visible := TRUE; - ParentForm.fCurrentControl := @ Self; - Parent.fCurrentControl := @ Self; + ParentForm.DF.fCurrentControl := @ Self; + Parent.DF.fCurrentControl := @ Self; Parent.Postmsg( CM_QUIT, DWORD( Sender ), 0 ); end else - if Assigned( fEditCtl ) then + if Assigned( DF.fEditCtl ) then begin - fEditCtl.fLeave( fEditCtl ); + DF.fEditCtl.EV.fLeave( DF.fEditCtl ); end; end; @@ -62521,29 +61735,26 @@ begin Text := PControl( Sender ).Text; end; -procedure TControl.GraphEditboxSetFocus; -begin - EditGraphEdit; -end; - procedure TControl.DestroyGraphEdit(Sender: PObj); begin - fEditCtl := nil; + DF.fEditCtl := nil; end; procedure TControl.GraphCtlDrawFocusRect(DC: HDC; const R: TRect); var rgn: HRgn; begin - if fFocused and (GetActiveWindow = ParentForm.Handle) then + if {$IFDEF USE_FLAGS} (G2_Focused in fFlagsG2) + {$ELSE} fFocused {$ENDIF} + and (GetActiveWindow = ParentForm.Handle) then begin - BeginPath( DC ); - Canvas.FrameRect( R ); - EndPath( DC ); - Canvas.FrameRect( R ); - DrawFocusRect( DC, R ); - rgn := PathToRegion( DC ); - ExtSelectClipRgn( DC, rgn, RGN_DIFF ); - DeleteObject( rgn ); + BeginPath( DC ); + Canvas.FrameRect( R ); + EndPath( DC ); + Canvas.FrameRect( R ); + DrawFocusRect( DC, R ); + rgn := PathToRegion( DC ); + ExtSelectClipRgn( DC, rgn, RGN_DIFF ); + DeleteObject( rgn ); end; end; @@ -62554,16 +61765,16 @@ var bk_erased: Boolean; var R: TRect; begin bk_erased := TRUE; - if Assigned( OnEraseBkgnd ) then - OnEraseBkgnd( @ Self, DC ) + if Assigned( EV.fOnEraseBkgnd ) then + EV.fOnEraseBkgnd( @ Self, DC ) else begin - R := BoundsRect; - OffsetRect( R, -R.Left, -R.Top ); - SetBkMode( DC, OPAQUE ); - SetBkColor( DC, Color2RGB( fColor ) ); - SetBrushOrgEx( DC, 0, 0, nil ); - Windows.FillRect( DC, R, Global_GetCtlBrushHandle( @ Self ) ); + R := BoundsRect; + OffsetRect( R, -R.Left, -R.Top ); + SetBkMode( DC, OPAQUE ); + SetBkColor( DC, Color2RGB( fColor ) ); + SetBrushOrgEx( DC, 0, 0, nil ); + Windows.FillRect( DC, R, Global_GetCtlBrushHandle( @ Self ) ); end; end; @@ -62576,7 +61787,7 @@ var R, R1, R0: TRect; Flag: DWORD; {$ENDIF} begin - if not fErasingBkgnd then + if not DF.fErasingBkgnd then Exit; R := ClientRect; Dec( R.Top, 14 { Self_.fClientTop div 2 } ); @@ -62592,20 +61803,23 @@ begin for i := 0 to ChildCount-1 do begin C := Children[ i ]; - if not C.fWindowed and C.fVisible then + if {$IFDEF USE_FLAGS} (G6_GraphicCtl in C.fFlagsG6) + {$ELSE} not C.fWindowed {$ENDIF} + and {$IFDEF USE_FLAGS} (F3_Visible in C.fStyle.f3_Style) + {$ELSE} C.fVisible {$ENDIF} then begin - rgn := CreateRectRgnIndirect( C.BoundsRect ); - ExtSelectClipRgn( DC, rgn, RGN_DIFF ); - DeleteObject( rgn ); + rgn := CreateRectRgnIndirect( C.BoundsRect ); + ExtSelectClipRgn( DC, rgn, RGN_DIFF ); + DeleteObject( rgn ); end; end; {$IFDEF GRAPHCTL_XPSTYLES} OpenThemeDataProc; Theme := 0; - if Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then - Theme := fOpenThemeDataProc( 0, 'Button' ); - if Theme <> 0 then + if Assigned( fOpenThemeDataProc ) and not DoNotDrawGraphCtlsUsingXPStyles then + Theme := fOpenThemeDataProc( 0, 'Button' ); + if Theme <> 0 then begin DoEraseBkgnd; @@ -62716,12 +61930,16 @@ begin end; {$ENDIF USE_GRAPHCTLS} +{$IFDEF ASM_VERSION} +{$ELSE PASCAL} function TControl.MakeWordWrap: PControl; begin - fWordWrap := TRUE; - Style := fStyle and not SS_LEFTNOWORDWRAP; - Result := @ Self; + {$IFDEF USE_FLAGS} include( fFlagsG1, G1_WordWrap ); + {$ELSE} fWordWrap := TRUE; {$ENDIF} + Style := fStyle.Value and not SS_LEFTNOWORDWRAP; + Result := @ Self; end; +{$ENDIF ASM_VERSION} function ParentAnchorChildren( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; @@ -62765,7 +61983,6 @@ begin else if C.AnchorBottom then C.Top := C.Top + dH; end; - end; Sender.fOldWidth := NewW; Sender.fOldHeight := NewH; @@ -62774,62 +61991,21 @@ end; function TControl.Anchor(aLeft, aTop, aRight, aBottom: Boolean): PControl; begin - if (not aLeft) and aRight then - SetAnchorLeft( FALSE ) + if (not aLeft) and aRight then + AnchorLeft := FALSE else - SetAnchorLeft( aLeft ); + AnchorLeft := aLeft; - if (not aTop) and aBottom then - SetAnchorTop( FALSE ) + if (not aTop) and aBottom then + AnchorTop := FALSE else - SetAnchorTop( aTop ); - - SetAnchorRight( aRight ); - SetAnchorBottom( aBottom ); + AnchorTop := aTop; + AnchorRight := aRight; + AnchorBottom := aBottom; Result := @ Self; end; -procedure TControl.SetAnchorLeft(const Value: Boolean); -begin - fAnchorLeft := Value; - if Parent <> nil then - begin - fParent.AttachProc( ParentAnchorChildren ); - Parent.fOldWidth := Parent.ClientWidth; - end; -end; - -procedure TControl.SetAnchorTop(const Value: Boolean); -begin - fAnchorTop := Value; - if Parent <> nil then - begin - fParent.AttachProc( ParentAnchorChildren ); - fParent.fOldHeight := Parent.ClientHeight; - end; -end; - -procedure TControl.SetAnchorBottom(Value: Boolean); -begin - fAnchorBottom := Value; - if Parent <> nil then - begin - fParent.AttachProc( ParentAnchorChildren ); - fParent.fOldHeight := Parent.ClientHeight; - end; -end; - -procedure TControl.SetAnchorRight(Value: Boolean); -begin - fAnchorRight := Value; - if Parent <> nil then - begin - Parent.AttachProc( ParentAnchorChildren ); - Parent.fOldWidth := Parent.ClientWidth; - end; -end; - function TControl.GetLBTopIndex: Integer; begin Result := Perform(LB_GETTOPINDEX,0,0); @@ -62858,6 +62034,1477 @@ begin end; {$ENDIF WIN_GDI} + +{$IFDEF ASM_VERSION}{$ELSE PAS_VERSION} +function TControl.FormGetIntParam: Integer; +var //Shft: Integer; + C: Byte; + Sign, Cont: Boolean; +begin + Result := 0; + while TRUE do + begin + C := Byte( DF.FormParams^ ); + inc( DF.FormParams ); + Cont := C and 1 <> 0; + C := C shr 1; + if Cont then + Result := (Result shl 7) or C + else + begin + Sign := C and 1 <> 0; + C := C shr 1; + Result := (Result shl 6) or C; + if Sign then + Result := -Result; + break; + end; + end; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE} +function TControl.FormGetColorParam: Integer; +begin + Result := FormGetIntParam; + Result := (Result shr 1) or (Result shl 31); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure TControl.FormGetStrParam; +var i: Integer; +begin + i := FormGetIntParam; + SetString( FormString, DF.FormParams, i ); + inc( DF.FormParams, i ); +end; +{$ENDIF ASM_VERSION} + +procedure TControl.FormCreateParameters( + alphabet: PFormInitFuncArray; + params: PAnsiChar ); +//var i: Integer; +begin + DF.FormCurrentParent := @Self; + DF.FormLastCreatedChild := @Self; + DF.FormParams := params; + DF.FormAlphabet := alphabet; +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure TControl.FormExecuteCommands(AForm: PControl; ControlPtrOffsets: PSmallIntArray); +var //c: Char; + //i, + N: Integer; + Ctrl: PPcontrol; +begin + //i := 0; + while {FormParams <> ''} TRUE do + begin + N := FormGetIntParam; + if N = 0 then + break; + if N < 0 then + begin + N := -N; + Ctrl := PPControl( Pointer( Integer(AForm) + + (ControlPtrOffsets[0] shl 2) ) ); + ControlPtrOffsets := Pointer( Integer( ControlPtrOffsets ) + 2 ); + //inc( i ); + Ctrl^ := DF.FormAlphabet[N-1]( @Self ); + DF.FormLastCreatedChild := Ctrl^; + end + else + begin + Ctrl := @ DF.FormLastCreatedChild; + PFormInitFuncArray1( DF.FormAlphabet )[N-1]( Ctrl^, 1 ); + end; + end; + FormString := ''; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION} +procedure FormPrepareStrParamCreateCtrl; +asm + PUSH EAX + CALL TControl.FormGetStrParam + POP ECX + MOV EAX, [ECX].TControl.DF.FormCurrentParent + MOV EDX, [ECX].TControl.FormString +end; + +procedure FormPrepareIntParamCreateCtrl; +asm + PUSH EAX + CALL TControl.FormGetIntParam + XCHG EDX, EAX + POP ECX + MOV EAX, [ECX].TControl.DF.FormCurrentParent +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE} +function FormNewLabel( Form: PControl ): PControl; +begin + Form.FormGetStrParam; + Result := NewLabel( Form.DF.FormCurrentParent, + Form.FormString ); +end; +{$ENDIF} + +{$IFDEF ASM_VERSION}{$ELSE} +function FormNewWordWrapLabel( Form: PControl ): PControl; +begin + Form.FormGetStrParam; + Result := NewWordWrapLabel( Form.DF.FormCurrentParent, + Form.FormString ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE} +function FormNewLabelEffect( Form: PControl ): PControl; +var Shd: Integer; +begin + Form.FormGetStrParam; + Shd := Form.FormGetIntParam; + Result := NewLabelEffect( Form.DF.FormCurrentParent, Form.FormString, Shd ); +end; +{$ENDIF} + +{$IFDEF ASM_VERSION}{$ELSE} +function FormNewButton( Form: PControl ): PControl; +begin + Form.FormGetStrParam; + Result := NewButton( Form.DF.FormCurrentParent, Form.FormString ); +end; +{$ENDIF} + +function FormNewBitBtn( Form: PControl ): PControl; +type PBitBtnOptions = ^TBitBtnOptions; +var Cap: KOLString; + i, j, k, bmp: Integer; +begin + Form.FormGetStrParam; + Cap := Form.FormString; + i := Form.FormGetIntParam; + j := Form.FormGetIntParam; + Form.FormGetStrParam; + k := Form.FormGetIntParam; + bmp := 0; + if Form.FormString <> '' then + bmp := LoadBmp( hInstance, PKOLChar( KOLString( Form.FormString ) ), Form ); + Result := NewBitBtn( Form.DF.FormCurrentParent, Cap, + PBitBtnOptions( @i )^, + TGlyphLayout( j ), + bmp, k ); +end; + +{$IFDEF ASM_VERSION}{$ELSE} +function FormNewPanel( Form: PControl ): PControl; +begin + Result := NewPanel( Form.DF.FormCurrentParent, + TEdgeStyle( Form.FormGetIntParam ) ); +end; +{$ENDIF} + +function FormNewGradientPanel( Form: PControl ): PControl; +var C1, C2: TColor; +begin + C1 := Form.FormGetColorParam; + C2 := Form.FormGetColorParam; + Result := NewGradientPanel( Form.DF.FormCurrentParent, C1, C2 ); +end; + +function FormNewGradientPanelEx( Form: PControl ): PControl; +var C1, C2: TColor; + Style, Layout: Integer; +begin + C1 := Form.FormGetColorParam; + C2 := Form.FormGetColorParam; + Style := Form.FormGetIntParam; + Layout := Form.FormGetIntParam; + Result := NewGradientPanelEx( Form.DF.FormCurrentParent, C1, C2, + TGradientStyle( Style ), TGradientLayout( Layout ) ); +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +function FormNewGroupbox( Form: PControl ): PControl; +begin + Form.FormGetStrParam; + Result := NewGroupbox( Form.DF.FormCurrentParent, + Form.FormString ); +end; +{$ENDIF ASM_VERSION} + +function FormNewPaintbox( Form: PControl ): PControl; +begin + Result := NewPaintbox( Form.DF.FormCurrentParent ); +end; + +{$IFDEF ASM_VERSION}{$ELSE} +function FormNewEditBox( Form: PControl ): PControl; +type PEditOptions = ^TEditOptions; +var i: Integer; +begin + i := Form.FormGetIntParam; + Result := NewEditbox( Form.DF.FormCurrentParent, PEditOptions( @ i )^ ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF USE_RICHEDIT} +{$IFDEF ASM_VERSION} +function FormNewRichEdit( Form: PControl ): PControl; +asm + CALL FormPrepareIntParamCreateCtrl + CALL NewRichEdit +end; +{$ELSE} +function FormNewRichEdit( Form: PControl ): PControl; +type PEditOptions = ^TEditOptions; +var i: Integer; +begin + i := Form.FormGetIntParam; + Result := NewRichEdit( Form.DF.FormCurrentParent, + PEditOptions( @ i )^ ); +end; +{$ENDIF ASM_VERSION} +{$ENDIF USE_RICHEDIT} + +{$IFDEF ASM_VERSION}{$ELSE} +function FormNewComboBox( Form: PControl ): PControl; +type PComboOptions = ^TComboOptions; +var i: Integer; +begin + i := Form.FormGetIntParam; + Result := NewCombobox( Form.DF.FormCurrentParent, PComboOptions( @ i )^ ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE} +function FormNewCheckbox( Form: PControl ): PControl; +begin + Form.FormGetStrParam; + Result := NewCheckbox( Form.DF.FormCurrentParent, Form.FormString ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE} +function FormNewRadiobox( Form: PControl ): PControl; +begin + Form.FormGetStrParam; + Result := NewRadiobox( Form.DF.FormCurrentParent, Form.FormString ); +end; +{$ENDIF ASM_VERSION} + +function FormNewSplitter( Form: PControl ): PControl; +var p, n: Integer; +begin + p := Form.FormGetIntParam; + n := Form.FormGetIntParam; + Result := NewSplitter( Form.DF.FormCurrentParent, p, n ); +end; + +{$IFDEF ASM_VERSION}{$ELSE} +function FormNewListbox( Form: PControl ): PControl; +type PListOptions = ^TListOptions; +var i: Integer; +begin + i := Form.FormGetIntParam; + Result := NewListbox( Form.DF.FormCurrentParent, PListOptions( @ i )^ ); +end; +{$ENDIF ASM_VERSION} + +function FormNewListView( Form: PControl ): PControl; +type PListViewOptions = ^TListViewOptions; +var lvs: TListViewStyle; + i: Integer; +begin + lvs := TListViewStyle( Form.FormGetIntParam ); + i := Form.FormGetIntParam; + Result := NewListView( Form.DF.FormCurrentParent, + lvs, PListViewOptions( @i )^, + nil, nil, nil ); +end; + +function FormNewTreeView( Form: PControl ): PControl; +type PTreeViewOptions = ^TTreeViewOptions; +var i: Integer; +begin + i := Form.FormGetIntParam; + Result := NewTreeView( Form.DF.FormCurrentParent, + PTreeViewOptions( @i )^, + nil, nil ); +end; + +function FormNewScrollbox( Form: PControl ): PControl; +type PScrollerBars = ^TScrollerBars; +var es: TEdgeStyle; + b: Integer; +begin + es := TEdgeStyle( Form.FormGetIntParam ); + b := Form.FormGetIntParam; + Result := NewScrollbox( Form.DF.FormCurrentParent, es, PScrollerBars( @ b )^ ); +end; + +function FormNewScrollboxEx( Form: PControl ): PControl; +begin + Result := NewScrollboxEx( Form.DF.FormCurrentParent, + TEdgeStyle( Form.FormGetIntParam ) ); +end; + +function FormNewScrollBar( Form: PControl ): PControl; +begin + Result := NewScrollbar( Form.DF.FormCurrentParent, + TScrollerBar( Form.FormGetIntParam ) ); +end; + +function FormNewProgressBar( Form: PControl ): PControl; +begin + Result := NewProgressBar( Form.DF.FormCurrentParent ); +end; + +function FormNewProgressBarEx( Form: PControl ): PControl; +type PProgressbarOptions = ^TProgressbarOptions; +begin + Result := NewProgressBarEx( Form.DF.FormCurrentParent, + PProgressbarOptions(Form.FormGetIntParam)^ ); +end; + +{function FormNewToolbar( Form: PControl ): PControl; +type PToolbarOptions = ^TToolbarOptions; +type TAnsiStringArray = array[0..65535] of String; + PAnsiStringArray = ^TAnsiStringArray; +var a, o, m, b, N, N2, i: Integer; + map: array[0..1] of Integer; + butt1: PKOLStrList; + butt2: array[0..255] of PKOLChar; + imgs: array of Integer; +begin + a := Form.FormGetIntParam; + o := Form.FormGetIntParam; + m := Form.FormGetIntParam; + CASE m OF + 1: begin + Form.FormGetStrParam; + map[0] := Form.FormGetIntParam; + map[0] := Color2RGB( clBtnFace ); + b := LoadMappedBitmapEx( Form, hInstance, PKOLChar( Form.FormString ), map ); + end; + 2: begin + Form.FormGetStrParam; + b := LoadBmp( hInstance, PKOLChar( Form.FormString ), Form ); + end; + else + b := m; + END; + N := Form.FormGetIntParam; // N must be < 256 + butt1 := NewKOLStrList; + for i := 0 to N-1 do + begin + Form.FormGetStrParam; + butt1.Add( Form.FormString ); + butt2[i] := butt1.ItemPtrs[i]; + end; + butt2[N] := nil; + N2 := Form.FormGetIntParam; // N2 must be < 256 + SetLength( imgs, N2 ); + for i := 0 to N2-1 do + imgs[i] := Form.FormGetIntParam; + Result := NewToolbar( Form.DF.FormCurrentParent, + TControlAlign( a ), + PToolbarOptions( @ o )^, + b, + butt2, + imgs ); + Free_And_Nil(butt1); +end;} + +function FormNewDateTimePicker( Form: PControl ): PControl; +type PDateTimePickerOptions = ^TDateTimePickerOptions; +var o: Integer; +begin + o := Form.FormGetIntParam; + Result := NewDateTimePicker( Form.DF.FormCurrentParent, + PDateTimePickerOptions( @ o )^ ); +end; + +{$IFDEF _D4orHigher} +function FormNewTabControl( Form: PControl ): PControl; +type PTabControlOptions = ^TTabControlOptions; +var N, i, o: Integer; + Tabs1: array of KOLString; + Tabs2: array of PKOLChar; +begin + N := Form.FormGetIntParam; + SetLength( Tabs1, N ); + SetLength( Tabs2, N ); + for i := 0 to N-1 do + begin + Form.FormGetStrParam; + Tabs1[i] := Form.FormString; + Tabs2[i] := PKOLChar( Tabs1[i] ); + end; + o := Form.FormGetIntParam; + i := Form.FormGetIntParam; + Result := NewTabControl( Form.DF.FormCurrentParent, + Tabs2, + PTabControlOptions(@ o)^, + nil, i ); + SetLength( Tabs1, 0 ); + SetLength( Tabs2, 0 ); +end; +{$ENDIF} + +{$IFDEF ASM_VERSION} +//!!! asm version returns in EAX Control, +// and integer parameter in EDX and ECX (EDX=ECX) !!! +//--- this is enough to call method of Control with a single int param --- +function ParentForm_IntParamAsm(Control: PControl): Integer; +asm + PUSH EAX + CALL TControl.ParentForm + CALL TControl.FormGetIntParam + XCHG EDX, EAX + MOV ECX, EDX + POP EAX +end; + +function ParentForm_ColorParamAsm(Control: PControl): Integer; +asm + CALL ParentForm_IntParamAsm + ROR EDX, 1 +end; +{$ENDIF ASM_VERSION} + +function ParentForm_PCharParam(Control: PControl): PKOLChar; +var Form: PControl; +begin + Form := Control.ParentForm; + Form.FormGetStrParam; + Result := PKOLChar( KOLString( Form.FormString ) ); +end; + +function ParentForm_IntParamPas(Form: PControl): Integer; +begin + Result := Form.ParentForm.FormGetIntParam; +end; + +function ParentForm_ColorParamPas(Form: PControl): Integer; +begin + Result := Form.ParentForm.FormGetColorParam; +end; + +{$IFDEF ASM_VERSION} +// only to call from asm -- returns EAX=Parent Form, EDX=ECX=PChar param +function ParentForm_PCharParamAsm(Control: PControl): PChar; +asm + PUSH EAX + CALL ParentForm_PCharParam + XCHG EDX, EAX + MOV ECX, EDX + POP EAX +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetSize( Form: PControl ); +var W, H: Integer; +begin + W := ParentForm_IntParamPas( Form ); + H := ParentForm_IntParamPas( Form ); + Form.SetSize( W, H ); +end; +{$ENDIF} + +procedure FormSetHeight( Form: PControl ); +begin + Form.Height := ParentForm_IntParamPas(Form); +end; + +procedure FormSetWidth( Form: PControl ); +begin + Form.Width := ParentForm_IntParamPas(Form); +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetPosition( Form: PControl ); +var X, Y: Integer; +begin + X := ParentForm_IntParamPas(Form); + Y := ParentForm_IntParamPas(Form); + Form.SetPosition( X, Y ); +end; +{$ENDIF} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetClientSize( Form: PControl ); +var W, H: Integer; +begin + W := ParentForm_IntParamPas(Form); + H := ParentForm_IntParamPas(Form); + Form.SetClientSize( W, H ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetAlign( Form: PControl ); +begin + Form.SetAlign( TControlAlign( ParentForm_IntParamPas(Form) ) ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF USE_NAMES} +procedure FormSetName( Form: PControl ); +var C: PControl; +begin + C := Form; + Form := Form.ParentForm; + Form.FormGetStrParam; + C.SetName( Form, Form.FormString ); +end; +{$ENDIF USE_NAMES} + +{$IFDEF UNICODE_CTRLS} +procedure FormSetUnicode( Form: PControl ); +begin + Form.SetUnicode( TRUE ); +end; +{$ENDIF UNICODE_CTRLS} + +procedure FormAssignHelpContext( Form: PControl ); +begin + Form.AssignHelpContext( ParentForm_IntParamPas( Form ) ); +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetCanResizeFalse( Form: PControl ); +begin + Form.CanResize := FALSE; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormInitMenu( Form: PControl ); +begin + Form.Perform( WM_INITMENU, 0, 0 ); +end; +{$ENDIF ASM_VERSION} + +procedure FormSizeGripFalse( Form: PControl ); +begin + Form.SizeGrip := FALSE; +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetExStyle( Form: PControl ); +begin + Form.ExStyle := Form.ExStyle or DWORD( ParentForm_IntParamPas(Form) ); +end; +{$ENDIF} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetVisibleFalse( Form: PControl ); +begin + Form.Visible := FALSE; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetEnabledFalse( Form: PControl ); +begin + Form.Enabled := FALSE; +end; +{$ENDIF} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormResetStyles( Form: PControl ); +begin + Form.Style := Form.Style and not ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetStyle( Form: PControl ); +begin + Form.Style := Form.Style or DWORD( ParentForm_IntParamPas(Form)); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetAlphaBlend( Form: PControl ); +begin + Form.AlphaBlend := ParentForm_IntParamPas( Form ); +end; +{$ENDIF} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetHasBorderFalse( Form: PControl ); +begin + Form.HasBorder := FALSE; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetHasCaptionFalse( Form: PControl ); +begin + Form.HasCaption := FALSE; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormResetCtl3D( Form: PControl ); +begin + Form.Ctl3D := FALSE; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormIconLoad_hInstance( Form: PControl ); +begin + Form.IconLoad( hInstance, + MAKEINTRESOURCE( ParentForm_IntParamPas(Form) ) ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormIconLoadCursor_0( Form: PControl ); +begin + Form.IconLoadCursor( 0, MakeIntResource( ParentForm_IntParamPas(Form) ) ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetIconNeg1( Form: PControl ); +begin + Form.Icon := THandle( -1 ); +end; +{$ENDIF ASM_VERSION} + +procedure FormIconLoad_hInstance_str( Form: PControl ); +begin + Form.FormGetStrParam; + Form.IconLoad( hInstance, PKOLChar( KOLString( Form.FormString ) ) ); +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetWindowState( Form: PControl ); +begin + Form.WindowState := TWindowState( ParentForm_IntParamPas(Form) ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormCursorLoad_0( Form: PControl ); +begin + Form.CursorLoad( 0, MAKEINTRESOURCE( ParentForm_IntParamPas(Form) ) ); +end; +{$ENDIF ASM_VERSION} + +procedure FormCursorLoad_hInstance( Form: PControl ); +var C: PControl; +begin + C := Form; + Form := Form.ParentForm; + Form.FormGetStrParam; + C.CursorLoad( 0, PKOLChar( KOLString( Form.FormString ) ) ); +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetColor( Form: PControl ); +begin + Form.Color := ParentForm_ColorParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetBrushStyle( Form: PControl ); +begin + Form.Brush.BrushStyle := TBrushStyle( ParentForm_IntParamPas(Form) ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetBrushBitmap( Form: PControl ); +var C: PControl; +begin + C := Form; + Form := Form.ParentForm; + {$IFDEF UNICODE_CTRLS} + Form.FormGetStrParam; + {$ENDIF} + C.Brush.BrushBitmap := + LoadBmp( hInstance, + {$IFDEF UNICODE_CTRLS} + PKOLChar( KOLString( Form.FormString ) ) + {$ELSE} + ParentForm_PCharParam(Form) + {$ENDIF} + , Form ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetFontColor( Form: PControl ); +begin + Form.Font.Color := ParentForm_ColorParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetFontStyles( Form: PControl ); +type PFontStyle = ^TFontStyle; +var fs: Byte; +begin + fs := ParentForm_IntParamPas(Form); + Form.Font.FontStyle := PFontStyle( @ fs )^; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetFontHeight( Form: PControl ); +begin + Form.Font.FontHeight := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetFontWidth( Form: PControl ); +begin + Form.Font.FontWidth := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +procedure ParentForm_StrParam( Form: PControl ); +begin + Form := Form.ParentForm; + Form.FormGetStrParam; +end; + +procedure FormSetFontName( Form: PControl ); +begin + ParentForm_StrParam(Form); + Form.Font.FontName := Form.ParentForm.FormString; +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetFontOrientation( Form: PControl ); +begin + Form.Font.FontOrientation := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetFontCharset( Form: PControl ); +begin + Form.Font.FontCharset := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetFontPitch( Form: PControl ); +begin + Form.Font.FontPitch := TFontPitch( ParentForm_IntParamPas(Form) ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetBorder( Form: PControl ); +begin + Form.Border := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetMarginTop( Form: PControl ); +begin + Form.MarginTop := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetMarginBottom( Form: PControl ); +begin + Form.MarginBottom := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetMarginLeft( Form: PControl ); +begin + Form.MarginLeft := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetMarginRight( Form: PControl ); +begin + Form.MarginRight := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetSimpleStatusText( Form: PControl ); +begin + Form.SimpleStatusText := ParentForm_PCharParam(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetStatusText( Form: PControl ); +var I: Integer; +begin + I := ParentForm_IntParamPas(Form); + Form.StatusText[I] := ParentForm_PCharParam(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormRemoveCloseIcon( Form: PControl ); +begin + DeleteMenu( GetSystemMenu( Form.GetWindowHandle, False ), + SC_CLOSE, MF_BYCOMMAND ); +end; +{$ENDIF ASM_VERSION} + +procedure FormSetEraseBkgndTrue( Form: PControl ); +begin + Form.EraseBackground := TRUE; +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetMinWidth( Form: PControl ); +begin + Form.MinWidth := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetMaxWidth( Form: PControl ); +begin + Form.MaxWidth := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetMinHeight( Form: PControl ); +begin + Form.MinHeight := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetMaxHeight( Form: PControl ); +begin + Form.MaxHeight := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF noASM_VERSION} +procedure FormSetRepeatInterval( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + MOV [EAX].TControl.fRepeatInterval, EDX +end; +{$ELSE PAS_VERSION} +procedure FormSetRepeatInterval( Form: PControl ); +begin + Form.RepeatInterval := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +procedure FormSetKeyPreviewTrue( Form: PControl ); +begin +{$IFDEF KEY_PREVIEW} + Form.KeyPreview := TRUE; +{$ENDIF} +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetTextShiftX( Form: PControl ); +begin + Form.TextShiftX := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetTextShiftY( Form: PControl ); +begin + Form.TextShiftY := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetColor2( Form: PControl ); +begin + Form.Color2 := ParentForm_ColorParamPas( Form ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetTextAlign( Form: PControl ); +begin + Form.TextAlign := TTextAlign( ParentForm_IntParamPas(Form) ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetTextVAlign( Form: PControl ); +begin + Form.VerticalAlign := TVerticalAlign( ParentForm_IntParamPas(Form) ); +end; +{$ENDIF ASM_VERSION} + +procedure FormSetTabStopFalse( Form: PControl ); +begin + Form.TabStop := FALSE; +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetIgnoreDefault( Form: PControl ); +begin + Form.IgnoreDefault := Boolean( ParentForm_IntParamPas(Form) ); +end; +{$ENDIF ASM_VERSION} + +procedure FormSetHintText( Form: PControl ); +begin + {$IFDEF USE_MHTOOLTIP} + ParentForm_StrParam(Form); + Form.Hint.Text := Form.ParentForm.FormString; + {$ENDIF USE_MHTOOLTIP} +end; + +procedure FormSetAnchor( Form: PControl ); +var i: Integer; +begin + i := ParentForm_IntParamPas(Form); + Form.AnchorLeft := I and 1 <> 0; + Form.AnchorTop := I and 2 <> 0; + Form.AnchorRight := I and 4 <> 0; + Form.AnchorBottom := I and 8 <> 0; +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetCaption( Form: PControl ); +var Ctl: PControl; +begin + Ctl := Form; + Form := Form.ParentForm; + Form.FormGetStrParam; + Ctl.Caption := Form.FormString; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetGradienStyle( Form: PControl ); +begin + Form.GradientStyle := TGradientStyle( ParentForm_IntParamPas(Form) ); +end; +{$ENDIF ASM_VERSION} + +procedure FormOverrideScrollbars( Form: PControl ); +begin + OverrideScrollbars( Form ); +end; + +{$IFDEF USE_RICHEDIT} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetRE_AutoFontFalse( Form: PControl ); +begin + Form.RE_AutoFont := FALSE; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetRE_AutoFontSizeAdjustFalse( Form: PControl ); +begin + Form.RE_AutoFontSizeAdjust := FALSE; +end; +{$ENDIF PASCAL} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetRE_DualFontTrue( Form: PControl ); +begin + Form.RE_DualFont := TRUE; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetRE_UIFontsTrue( Form: PControl ); +begin + Form.RE_UIFonts := TRUE; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetRE_IMECancelCompleteTrue( Form: PControl ); +begin + Form.RE_IMECancelComplete := TRUE; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetRE_IMEAlwaysSendNotifyTrue( Form: PControl ); +begin + Form.RE_IMEAlwaysSendNotify := TRUE; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetMaxTextSize( Form: PControl ); +begin + Form.MaxTextSize := DWORD( ParentForm_IntParamPas(Form) ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetRE_AutoKeyboardTrue( Form: PControl ); +begin + Form.RE_AutoKeyboard := TRUE; +end; +{$ENDIF ASM_VERSION} + +procedure FormSetRE_DisableOverwriteChangeTrue( Form: PControl ); +begin + Form.RE_DisableOverwriteChange := TRUE; +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetRE_Zoom( Form: PControl ); +var zoom: TSmallPoint; +begin + zoom.X := ParentForm_IntParamPas(Form); + zoom.Y := ParentForm_IntParamPas(Form); + Form.RE_Zoom := zoom; +end; +{$ENDIF ASM_VERSION} + +{$ENDIF USE_RICHEDIT} + +procedure FormSetListItems( Form: PControl ); +var N, i: Integer; +begin + N := ParentForm_IntParamPas(Form); + for i := 0 to N-1 do + begin + ParentForm_StrParam(Form); + Form.Items[i] := Form.ParentForm.FormString; + end; +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetCount( Form: PControl ); +begin + Form.Count := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetDroppedWidth( Form: PControl ); +begin + Form.DroppedWidth := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +procedure FormSetButtonIcon( Form: PControl ); +begin + Form.SetButtonIcon( LoadImage( hInstance, + ParentForm_PCharParam(Form), + IMAGE_ICON, 0, 0, $8000 {LR_SHARED} ) ); +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetButtonImage( Form: PControl ); +var w, h: Integer; +begin + w := ParentForm_IntParamPas(Form); + h := ParentForm_IntParamPas(Form); + Form.SetButtonIcon( LoadImage( hInstance, + ParentForm_PCharParam(Form), + IMAGE_ICON, w, h, $8000 {LR_SHARED} ) ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetButtonBitmap( Form: PControl ); +begin + Form.SetButtonBitmap( LoadBitmap( hInstance, + ParentForm_PCharParam(Form) ) ); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetMaxProgress( Form: PControl ); +begin + Form.MaxProgress := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetProgress( Form: PControl ); +begin + Form.Progress := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormLVColumsAdd( Form: PControl ); +var N, i, w: Integer; +begin + N := ParentForm_IntParamPas(Form); + for i := 0 to N-1 do + begin + w := ParentForm_IntParamPas(Form); + ParentForm_StrParam(Form); + Form.LVColAdd( Form.ParentForm.FormString, taLeft, w ); + end; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetLVColOrder( Form: PControl ); +var N, i: Integer; +begin + N := ParentForm_IntParamPas(Form); + i := ParentForm_IntParamPas(Form); + Form.LVColOrder[N] := i; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetLVColImage( Form: PControl ); +var N, i: Integer; +begin + N := ParentForm_IntParamPas(Form); + i := ParentForm_IntParamPas(Form); + Form.LVColImage[N] := i; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetTVIndent( Form: PControl ); +begin + Form.TVIndent := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +procedure FormSetTBBtnImgWidth( Form: PControl ); +begin + Form.TBBtnImgWidth := ParentForm_IntParamPas( Form ); +end; + +procedure FormTBAddBitmap( Form: PControl ); +var m: Boolean; + map: array[ 0..1 ] of TColor; + b: Integer; + C: PControl; +begin + C := Form; + Form := Form.ParentForm; + Form.FormGetStrParam; + m := Form.FormGetIntParam <> 0; + if m then + begin + map[0] := Form.FormGetColorParam; + map[1] := Color2RGB( clBtnFace ); + b := LoadMappedBitmapEx( Form, hInstance, PKOLChar( KOLString( Form.FormString )), map ); + end + else + begin + b := LoadBmp( hInstance, PKOLChar(KOLString(Form.FormString)), Form ); + end; + C.TBAddBitmap( b ); +end; + +procedure FormSetTBButtonSize( Form: PControl ); +//var HW: Integer; +begin + //HW := Form.Perform( TB_GETBUTTONSIZE, 0, 0 ); + Form.Perform( TB_SETBUTTONSIZE, 0, + ParentForm_IntParamPas(Form) or $10000 {or (HiWord(HW) shl 16)} ); +end; + +{$IFDEF _D4orHigher} +procedure FormTBSetTooltips( Form: PControl ); +var A1: array of KOLString; + A2: array of PKOLChar; + N, i: Integer; + C: PControl; +begin + C := Form; + Form := Form.ParentForm; + N := Form.FormGetIntParam; + SetLength( A1, N ); + SetLength( A2, N ); + for i := 0 to N-1 do + begin + Form.FormGetStrParam; + A1[i] := Form.FormString; + A2[i] := PKOLChar( A1[i] ); + end; + C.TBSetTooltips( 0, A2 ); + SetLength( A1, 0 ); + SetLength( A2, 0 ); +end; +{$ENDIF} + +procedure FormSetTBButtonsMinWidth( Form: PControl ); +begin + Form.TBButtonsMinWidth := ParentForm_IntParamPas(Form); +end; + +procedure FormSetTBButtonsMaxWidth( Form: PControl ); +begin + Form.TBButtonsMaxWidth := ParentForm_IntParamPas(Form); +end; + +procedure FormHideToolbarButton( Form: PControl ); +var i: Integer; +begin + i := ParentForm_IntParamPas(Form); + {$IFDEF USE_GRUSH} + ShowHideToolbarButton( Form, i, FALSE ); + {$ELSE} + Form.TBButtonVisible[ i ] := FALSE; + {$ENDIF} +end; + +procedure FormDisableToolbarButton( Form: PControl ); +var i: Integer; +begin + i := ParentForm_IntParamPas(Form); + {$IFDEF USE_GRUSH} + EnableToolbarButton( Form, i, FALSE ); + {$ELSE} + Form.TBButtonEnabled[ i ] := FALSE; + {$ENDIF} +end; + +procedure FormFixFlatXPToolbar( Form: PControl ); +begin + Form.OnTBCustomDraw := nil; +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetDateTimeFormat( Form: PControl ); +begin + ParentForm_StrParam(Form); + Form.DateTimeFormat := Form.ParentForm.FormString; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF noASM_VERSION} +procedure FormSetDateTimeColor( Form: PControl ); +asm + CALL ParentForm_ColorParamAsm + PUSH EDX + CALL ParentForm_IntParamAsm + POP ECX + CALL TControl.SetDateTimePickerColor +end; +{$ELSE PASCAL} +procedure FormSetDateTimeColor( Form: PControl ); +var i: Integer; + C: TColor; +begin + C := ParentForm_ColorParamPas( Form ); + i := ParentForm_IntParamPas( Form ); + Form.DateTimePickerColors[TDateTimePickerColor(i)] := C; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetCurrentTab( Form: PControl ); +var i: Integer; +begin + i := ParentForm_IntParamPas(Form); + Form.CurIndex := i; + Form.Pages[i].BringToFront; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetCurIdx( Form: PControl ); +begin + Form.CurIndex := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetSBMin( Form: PControl ); +begin + Form.SBMin := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetSBMax( Form: PControl ); +begin + Form.SBMax := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetSBPosition( Form: PControl ); +begin + Form.SBPosition := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetSBPageSize( Form: PControl ); +begin + Form.SBPageSize := ParentForm_IntParamPas(Form); +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormLastCreatedChildAsNewCurrentParent( Form: PControl ); +var C: PControl; +begin + C := Form; + Form := Form.ParentForm; + Form.DF.FormCurrentParent := C; +end; +{$ENDIF ASM_VERSION} + +procedure FormSetUpperParent( Form: PControl ); +begin + Form := Form.ParentForm; + Form.DF.FormCurrentParent := Form.DF.FormCurrentParent.Parent; +end; + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetTabpageAsParent( Form: PControl ); +var i: Integer; + C: PControl; +begin + C := Form; + Form := Form.ParentForm; + i := Form.FormGetIntParam; + Form.DF.FormCurrentParent := C.Pages[i]; +end; +{$ENDIF ASM_VERSION} + +{$IFDEF ASM_VERSION}{$ELSE PASCAL} +procedure FormSetCurCtl( Form: PControl ); +var i: Integer; + C: PControl; +begin + Form := Form.ParentForm; + i := Form.FormGetIntParam; + C := PPControl(Integer( Form.DF.FormAddress ) + i * 4)^; + if C = nil then + C := Form; + Form.DF.FormLastCreatedChild := C; +end; +{$ENDIF ASM_VERSION} + +procedure FormSetParent( Form: PControl ); +var C: PControl; +begin + C := Form; + Form := Form.ParentForm; + Form.DF.FormCurrentParent := C; +end; + +{$IFDEF ASM_VERSION} +procedure FormSetEvent( Form: PControl ); +asm + PUSH EDI + MOV EDI, EAX + PUSH ESI + CALL TControl.ParentForm + MOV ESI, EAX + PUSH [ESI].TControl.DF.FormObj + CALL ParentForm_IntParamAsm + MOV ESI, [EAX].TControl.DF.FormAlphabet + PUSH dword ptr [ESI+EDX*4] + CALL ParentForm_IntParamAsm + XCHG EAX, EDI + CALL dword ptr [ESI+EDX*4] + POP ESI + POP EDI +end; +{$ELSE} +procedure FormSetEvent( Form: PControl ); +type + TSetEventProc = procedure( TargetCtl: PControl; const event: TOnEvent ); +var C: PControl; + idx_handler, idx_setter: Integer; + handler, setter: Pointer; + event: TOnEvent; + set_proc: TSetEventProc; +begin + C := Form; + Form := Form.ParentForm; + idx_handler := Form.FormGetIntParam; + idx_setter := Form.FormGetIntParam; + handler := @Form.DF.FormAlphabet[idx_handler]; + setter := @Form.DF.FormAlphabet[idx_setter]; + set_proc := TSetEventProc( setter ); + Pointer( TMethod( event ).Code ) := handler; + TMethod( event ).Data := Form.DF.FormObj; + set_proc( PControl( C ), event ); +end; +{$ENDIF} + +{$IFDEF ASM_VERSION} +procedure FormSetIndexedEvent( Form: PControl ); +asm + PUSH EDI + MOV EDI, EAX + PUSH ESI + CALL TControl.ParentForm + MOV ESI, EAX + PUSH [ESI].TControl.DF.FormObj + CALL ParentForm_IntParamAsm + MOV ESI, [EAX].TControl.DF.FormAlphabet + PUSH dword ptr [ESI+EDX*4] + + CALL ParentForm_IntParamAsm // idx + PUSH EDX + + CALL ParentForm_IntParamAsm + XCHG EAX, EDI + MOV ECX, dword ptr [ESI+EDX*4] + + POP EDX + CALL ECX + POP ESI + POP EDI +end; +{$ELSE} +procedure FormSetIndexedEvent( Form: PControl ); +type + TSetIndexedEventProc = procedure( TargetCtl: PControl; Index: Integer; const event: TOnEvent ); +var C: PControl; + idx_handler, idx_setter, idx: Integer; + handler, setter: Pointer; + event: TOnEvent; + set_proc: TSetIndexedEventProc; +begin + C := Form; + Form := Form.ParentForm; + idx_handler := Form.FormGetIntParam; + idx := Form.FormGetIntParam; + idx_setter := Form.FormGetIntParam; + handler := @Form.DF.FormAlphabet[idx_handler]; + setter := @Form.DF.FormAlphabet[idx_setter]; + set_proc := TSetIndexedEventProc( setter ); + Pointer( TMethod( event ).Code ) := handler; + TMethod( event ).Data := Form.DF.FormObj; + set_proc( PControl( C ), idx, event ); +end; +{$ENDIF} + +procedure DummyOverrideScrollbars(Sender: PControl); +begin +end; + {$IFNDEF PAS_VERSION} // {$DEFINE ASM_VERSION} // {$DEFINE ASM_UNICODE} @@ -62871,7 +63518,6 @@ end; {$I CUSTOM_CODE_EXTENSION.inc} // See comments in TControl {$ENDIF USE_CUSTOMEXTENSIONS} -//[initialization] {$IFNDEF NOT_UNLOAD_RICHEDITLIB} {$IFDEF UNLOAD_RICHEDITLIB} @@ -62887,7 +63533,291 @@ end; {$DEFINE INIT_FINIT} {$ENDIF} +{$IFDEF EVENTS_DYNAMIC} +function TControl.ProvideUniqueEvents: PEvents; +begin + if EV = @EmptyEvents then + begin + GetMem( EV, Sizeof(TEvents) ); + Move( EmptyEvents, EV^, Sizeof(TEvents) ); + Add2AutoFreeEx( FreeEV ); + end; + Result := EV; +end; +procedure TControl.FreeEV; +begin + FreeMem( EV ); + EV := @EmptyEvents; +end; +function TControl.Get_OnHelp: TOnHelp; +begin Result := EV.fOnHelp; end; +procedure TControl.Set_OnHelp(const Value: TOnHelp); +begin + ProvideUniqueEvents.fOnHelp := Value; +end; +function TControl.Get_OnBitBtnDraw: TOnBitBtnDraw; +begin Result := EV.FOnBitBtnDraw; end; +procedure TControl.Set_OnBitBtnDraw(const Value: TOnBitBtnDraw); +begin + ProvideUniqueEvents.FOnBitBtnDraw := Value; +end; +function TControl.Get_OnMeasureItem: TOnMeasureItem; +begin Result := EV.fOnMeasureItem; end; +function TControl.Get_OnShow: TOnEvent; +begin Result := EV.fOnShow; end; +function TControl.Get_OnHide: TOnEvent; +begin Result := EV.fOnHide; end; +function TControl.Get_OnClose: TOnEventAccept; +begin Result := EV.fOnClose; end; +function TControl.Get_OnQueryEndSession: TOnEventAccept; +begin Result := EV.fOnQueryEndSession; end; +function TControl.Get_OnPaint: TOnPaint; +begin Result := EV.fOnPaint; end; +function TControl.Get_OnPrePaint: TOnPaint; +begin Result := EV.fOnPrepaint; end; +procedure TControl.Set_OnPrePaint(const Value: TOnPaint); +begin + ProvideUniqueEvents.fOnPrepaint := Value; +end; +function TControl.Get_OnPostPaint: TOnPaint; +begin Result := EV.fOnPostPaint; end; +procedure TControl.Set_OnPostPaint(const Value: TOnPaint); +begin + ProvideUniqueEvents.fOnPostPaint := Value; +end; +function TControl.Get_OnEraseBkgnd: TOnPaint; +begin Result := EV.fOnEraseBkgnd; end; +procedure TControl.Set_OnEraseBkgnd(const Value: TOnPaint); +begin + ProvideUniqueEvents.fOnEraseBkgnd := Value; + AttachProc( WndProcEraseBkgnd ); +end; +function TControl.Get_OnClick: TOnEvent; +begin Result := EV.fOnClick; end; +function TControl.Get_OnResize: TOnEvent; +begin Result := EV.fOnResize; end; +function TControl.Get_OnMove: TOnEvent; +begin Result := EV.fOnMove; end; +function TControl.Get_OnMoving: TOnEventMoving; +begin Result := EV.fOnMoving; end; +function TControl.Get_OnSplit: TOnSplit; +begin Result := EV.FOnSplit; end; +procedure TControl.Set_OnSplit(const Value: TOnSplit); +begin + ProvideUniqueEvents.FOnSplit := Value; +end; +function TControl.Get_OnKeyDown: TOnKey; +begin Result := EV.fOnKeyDown; end; +function TControl.Get_OnKeyUp: TOnKey; +begin Result := EV.fOnKeyUp; end; +function TControl.Get_OnChar: TOnChar; +begin Result := EV.fOnChar; end; +function TControl.Get_OnDeadChar: TOnChar; +begin Result := EV.fOnDeadChar; end; +function TControl.Get_OnMouseUp: TOnMouse; +begin Result := EV.fOnMouseUp; end; +function TControl.Get_OnMouseDown: TOnMouse; +begin Result := EV.fOnMouseDown; end; +function TControl.Get_OnMouseMove: TOnMouse; +begin Result := EV.fOnMouseMove; end; +function TControl.Get_OnMouseDblClk: TOnMouse; +begin Result := EV.fOnMouseDblClk; end; +function TControl.Get_OnMouseWheel: TOnMouse; +begin Result := EV.fOnMouseWheel; end; +function TControl.Get_OnMouseEnter: TOnEvent; +begin Result := EV.fOnMouseEnter; end; +function TControl.Get_OnMouseLeave: TOnEvent; +begin Result := EV.fOnMouseLeave; end; +function TControl.Get_OnTestMouseOver: TOnTestMouseOver; +begin Result := EV.fOnTestMouseOver; end; +function TControl.Get_OnEndEditLVItem: TOnEditLVItem; +begin Result := EV.fOnEndEditLVItem; end; +function TControl.Get_OnDeleteLVItem: TOnDeleteLVItem; +begin Result := EV.fOnDeleteLVItem; end; +function TControl.Get_OnLVData: TOnLVData; +begin Result := EV.fOnLVData; end; +function TControl.Get_OnCompareLVItems: TOnCompareLVItems; +begin Result := EV.fOnCompareLVItems; end; +procedure TControl.Set_OnCompareLVItems(const Value: TOnCompareLVItems); +begin + ProvideUniqueEvents.fOnCompareLVItems := Value; +end; +function TControl.Get_OnColumnClick: TOnLVColumnClick; +begin Result := EV.fOnColumnClick; end; +function TControl.Get_OnLVStateChange: TOnLVStateChange; +begin Result := EV.FOnLVStateChange; end; +function TControl.Get_OnDrawItem: TOnDrawItem; +begin Result := EV.fOnDrawItem; end; +function TControl.Get_OnLVCustomDraw: TOnLVCustomDraw; +begin Result := EV.fOnLVCustomDraw; end; +function TControl.Get_OnTVBeginDrag: TOnTVBeginDrag; +begin Result := EV.FOnTVBeginDrag; end; +procedure TControl.Set_OnTVBeginDrag(const Value: TOnTVBeginDrag); +begin + ProvideUniqueEvents.FOnTVBeginDrag := Value; +end; +function TControl.Get_OnTVBeginEdit: TOnTVBeginEdit; +begin Result := EV.FOnTVBeginEdit; end; +procedure TControl.Set_OnTVBeginEdit(const Value: TOnTVBeginEdit); +begin + ProvideUniqueEvents.FOnTVBeginEdit := Value; +end; +function TControl.Get_OnTVEndEdit: TOnTVEndEdit; +begin Result := EV.FOnTVEndEdit; end; +procedure TControl.Set_OnTVEndEdit(const Value: TOnTVEndEdit); +begin + ProvideUniqueEvents.fOnTVEndEdit := Value; +end; +function TControl.Get_OnTVExpanding: TOnTVExpanding; +begin Result := EV.FOnTVExpanding; end; +procedure TControl.Set_OnTVExpanding(const Value: TOnTVExpanding); +begin + ProvideUniqueEvents.FOnTVExpanding := Value; +end; +function TControl.Get_OnTVExpanded: TOnTVExpanded; +begin Result := EV.FOnTVExpanded; end; +procedure TControl.Set_OnTVExpanded(const Value: TOnTVExpanded); +begin + ProvideUniqueEvents.FOnTVExpanded := Value; +end; +function TControl.Get_OnTVDelete: TOnTVDelete; +begin Result := EV.FOnTVDelete; end; +function TControl.Get_OnTVSelChanging: TOnTVSelChanging; +begin Result := EV.fOnTVSelChanging; end; +procedure TControl.Set_OnTVSelChanging(const Value: TOnTVSelChanging); +begin + ProvideUniqueEvents.FOnTVSelChanging := Value; +end; +function TControl.Get_OnDTPUserString: TDTParseInputEvent; +begin Result := EV.FOnDTPUserString; end; +procedure TControl.Set_OnDTPUserString(const Value: TDTParseInputEvent); +begin + ProvideUniqueEvents.FOnDTPUserString := Value; +end; +function TControl.Get_OnSBBeforeScroll: TOnSBBeforeScroll; +begin Result := EV.FOnSBBeforeScroll; end; +procedure TControl.Set_OnSBBeforeScroll(const Value: TOnSBBeforeScroll); +begin + ProvideUniqueEvents.fOnSBBeforeScroll := Value; +end; +function TControl.Get_OnSBScroll: TOnSBScroll; +begin Result := EV.FOnSBScroll; end; +procedure TControl.Set_OnSBScroll(const Value: TOnSBScroll); +begin + ProvideUniqueEvents.FOnSBScroll := Value; +end; +function TControl.Get_OnScroll: TOnScroll; +begin Result := EV.fOnScroll; end; +function TControl.Get_OnMessage: TOnMessage; +begin Result := EV.fOnMessage; end; +procedure TControl.Set_OnMessage(const Value: TOnMessage); +begin + ProvideUniqueEvents.fOnMessage := Value; +end; +function TControl.Get_TOnEvent(const Index: Integer): TOnEvent; +begin + Result := TOnEvent( EV.MethodEvents[Index] ); +end; +procedure TControl.Set_TOnEvent(const Index: Integer; + const Value: TOnEvent); +begin + ProvideUniqueEvents.MethodEvents[Index] := TMethod( Value ); +end; +function TControl.Get_OnDropFiles: TOnDropFiles; +begin Result := EV.fOnDropFiles; end; +{$ENDIF EVENTS_DYNAMIC} + +{$IFnDEF NOT_USE_RICHEDIT} +procedure TControl.FreeCharFormatRec; +begin + FreeMem( DF.fRECharFormatRec ); +end; +{$ENDIF} + +function TControl.GetAnchor(const Index: Integer): Boolean; +begin + Result := fAnchors and Index <> 0; +end; + +procedure TControl.SetAnchor(const Index: Integer; const Value: Boolean); +begin + if Value then + fAnchors := fAnchors or Index + else fAnchors := fAnchors and not Index; + if Parent <> nil then + begin + fParent.AttachProc( ParentAnchorChildren ); + Parent.fOldWidth := Parent.ClientWidth; + Parent.fOldHeight := Parent.ClientHeight; + end; +end; + +function TControl.Get_StatusWnd: HWND; +begin + Result := 0; + if fStatusCtl <> nil then + Result := fStatusCtl.GetWindowHandle; +end; + +function TControl.Get_Prop_Int(PropName: PKOLChar): Integer; +begin + Result := GetProp( GetWindowHandle, PropName ); +end; + +procedure TControl.Set_Prop_Int(PropName: PKOLChar; const Value: Integer); +begin + SetProp( GetWindowHandle, PropName, Value ); +end; + +function TControl.GetHelpContext: Integer; +begin + Result := 0; + if fHandle <> 0 then + Result := GetWindowContextHelpId( fHandle ); +end; + +function TControl.Get_MDIClient: PControl; +begin + Result := Pointer( PropInt[ MDI_CLIENT ] ); +end; + +procedure TControl.Set_MDIClient(const Value: PControl); +begin + PropInt[ MDI_CLIENT ] := Integer( Value ); +end; + +function TControl.Get_Ctl3D: Boolean; +begin + Result := fCtl3D_child and 2 <> 0; +end; + +procedure TControl.ResetEvent(idx: Integer); +begin + TMethod( EV.MethodEvents[idx] ).Code := DummyProcTable[ InitEventsTable[ idx ] ]; + TMethod( EV.MethodEvents[idx] ).Data := nil; +end; + +{ TCommandActionsObj } + +{$IFDEF COMMANDACTIONS_OBJ} +{$IFDEF ASM_VERSION} +destructor TCommandActionsObj.Destroy; +asm + MOV EDX, [EAX].fIndexInActions + MOV dword ptr [EDX*4+AllActions_Objs], 0 + CALL TObj.Destroy +end; +{$ELSE} +destructor TCommandActionsObj.Destroy; +begin + AllActions_Objs[fIndexInActions] := nil; + inherited; +end; +{$ENDIF} +{$ENDIF} + {$IFDEF INIT_FINIT}//----------------------------------------------------------- + initialization {$IFDEF GRAPHCTL_XPSTYLES} CheckThemes; @@ -62895,7 +63825,6 @@ initialization InitThemes; {$ENDIF} -//[finalization] finalization {$IFDEF GRAPHCTL_XPSTYLES} if AppTheming then @@ -62910,6 +63839,10 @@ finalization {$ENDIF} {$ENDIF INIT_FINIT} -//[END OF KOL.pas] end. + + + + + diff --git a/KOLDEF.inc b/KOLDEF.inc index e39ac6e..89a3c2b 100644 --- a/KOLDEF.inc +++ b/KOLDEF.inc @@ -173,7 +173,7 @@ That is all to have full compatibility. {$DEFINE _D7} {$DEFINE _D7orHigher} {$ENDIF} -{$ENDIF} +{$ENDIF FPC} {$IFNDEF _NOT_KOLCtrlWrapper_} {$DEFINE _KOLCtrlWrapper_} @@ -232,5 +232,21 @@ That is all to have full compatibility. {$DEFINE PARANOIA} //seems not needed under D6 !!! Inprise fixed this, finally... {$ENDIF} -// use _SetDIBPixelsTrueColorWithAlpha for 32bit -{$DEFINE FIXDIB32} \ No newline at end of file + +{$IFNDEF USE_OLD_FLAGS} + {$DEFINE USE_FLAGS} +{$ELSE} {$UNDEF USE_FLAGS} +{$ENDIF} +{$IFnDEF EVENTS_STATIC} + {$DEFINE EVENTS_DYNAMIC} +{$ENDIF} +{$IFnDEF CMDACTIONS_RECORD} + {$DEFINE COMMANDACTIONS_OBJ} + {$DEFINE PACK_COMMANDACTIONS} + {$IFDEF NOT_PACK_COMMANDACTIONS} + {$UNDEF PACK_COMMANDACTIONS} + {$ENDIF} +{$ENDIF} + + + diff --git a/KOLDirDlgEx.pas b/KOLDirDlgEx.pas index 6c2251c..75f5737 100644 --- a/KOLDirDlgEx.pas +++ b/KOLDirDlgEx.pas @@ -5,7 +5,6 @@ interface uses Windows, Messages, KOL {$IFDEF USE_GRUSH}, ToGrush, KOLGRushControls {$ENDIF}; {$I KOLDEF.INC} -{$I DELPHIDEF.INC} {$IFDEF EXTERNAL_DEFINES} {$INCLUDE EXTERNAL_DEFINES.INC} @@ -56,6 +55,8 @@ uses Windows, Messages, KOL {$IFDEF USE_GRUSH}, ToGrush, KOLGRushControls {$ENDI обновлению, которое не реализовано - хотя и особой необходимости в автоматике на практике нет, и кроме дополнительной нагрузки на систему толку от такого автомата тоже не видно). + Особенно быстро диалог открытия работает в новых версиях OS Windows, + т.к. использует в этом случае API-функции версии Unicode. Дополнительные вкусности: Есть возможность поменять надписи на кнопках, заголовок диалога. @@ -69,6 +70,11 @@ type TFindFirstFileEx = function(lpFileName: PKOLChar; fInfoLevelId: TFindexInfoLevels; lpFindFileData: Pointer; fSearchOp: TFindexSearchOps; lpSearchFilter: Pointer; dwAdditionalFlags: DWORD): THandle; stdcall; + TFindFirstFileExW = function(lpFileName: PWideChar; fInfoLevelId: TFindexInfoLevels; + lpFindFileData: Pointer; fSearchOp: TFindexSearchOps; lpSearchFilter: Pointer; + dwAdditionalFlags: DWORD): THandle; stdcall; + TFindNextFileW = function( hFindFile: THandle; lpFindFileData: Pointer ): + BOOL; stdcall; POpenDirDialogEx = ^TOpenDirDialogEx; TOpenDirDialogEx = object( TObj ) @@ -81,9 +87,12 @@ type FPath, FRecycledName: KOLString; FRemoteIconSysIdx: Integer; FFindFirstFileEx: TFindFirstFileEx; + FFindFirstFileExW: TFindFirstFileExW; + FFindNextFileW: TFindNextFileW; k32: THandle; DialogForm, MsgPanel: PControl; function GetFindFirstFileEx: TFindFirstFileEx; + function GetFindFirstFileExW: TFindFirstFileExW; procedure SetPath(const Value: KOLString); function GetDialogForm: PControl; procedure DoOK( Sender: PObj ); @@ -101,6 +110,7 @@ type procedure CheckNodeHasChildren( node: Integer ); procedure CreateDialogForm; property _FindFirstFileEx: TFindFirstFileEx read GetFindFirstFileEx; + function _FindFirstFileExW: Boolean; procedure DeleteNode( node: Integer ); procedure DestroyingForm( Sender: PObj ); public @@ -281,6 +291,9 @@ var HasSubDirs: Boolean; txt: KOLString; F: THandle; Find32: TWin32FindData; + {$IFnDEF DONTTRY_FINDFILEEXW} + Find32W: TWin32FindDataW; + {$ENDIF} ii, n: Integer; begin HasSubDirs := FALSE; @@ -294,49 +307,51 @@ begin end; if not HasSubDirs then begin - if WinVer >= wvNT then + {$IFnDEF DONTTRY_FINDFILEEXW} + if (WinVer >= wvNT) and _FindFirstFileExW then begin - _FindFirstFileEx; - F := FFindFirstFileEx( PKOLChar( DirTree.TVItemPath( node, '\' ) + '\*.*' ), - FindExInfoStandard, @ Find32, FindExSearchLimitToDirectories, nil, 0 ); - if F <> INVALID_HANDLE_VALUE then - begin - while TRUE do + F := FFindFirstFileExW( PWideChar( + WideString( DirTree.TVItemPath( node, '\' ) + '\*.*' ) ), + FindExInfoStandard, @ Find32W, FindExSearchLimitToDirectories, nil, 0 ); + if F <> INVALID_HANDLE_VALUE then begin - if Find32.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then - if (Find32.cFileName <> String( '.' )) and (Find32.cFileName <> '..') then - if DoFilterAttrs( Find32.dwFileAttributes, Find32.cAlternateFileName ) then - begin - HasSubDirs := TRUE; - break; - end; - if not FindNextFile( F, Find32 ) then break; + while TRUE do + begin + if Find32W.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then + if (Find32W.cFileName <> WideString( '.' )) and (Find32.cFileName <> '..') then + if DoFilterAttrs( Find32W.dwFileAttributes, Find32W.cAlternateFileName ) then + begin + HasSubDirs := TRUE; + break; + end; + if not FindNextFileW( F, Find32W ) then break; + end; + if not FindClose( F ) then + {begin + asm + nop + end; + end}; end; - if not FindClose( F ) then - {begin - asm - nop - end; - end}; - end; end else + {$ENDIF} begin - F := FindFirstFile( PKOLChar( DirTree.TVItemPath( node, '\' ) + '\*.*' ), Find32 ); - if F <> INVALID_HANDLE_VALUE then - begin - while TRUE do + F := FindFirstFile( PKOLChar( DirTree.TVItemPath( node, '\' ) + '\*.*' ), Find32 ); + if F <> INVALID_HANDLE_VALUE then begin - if Find32.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then - if (Find32.cFileName <> String( '.' )) and (Find32.cFileName <> '..') then - begin - HasSubDirs := TRUE; - break; - end; - if not FindNextFile( F, Find32 ) then break; + while TRUE do + begin + if Find32.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then + if (Find32.cFileName <> String( '.' )) and (Find32.cFileName <> '..') then + begin + HasSubDirs := TRUE; + break; + end; + if not FindNextFile( F, Find32 ) then break; + end; + FindClose( F ); end; - FindClose( F ); - end; end; end; if not HasSubDirs then @@ -754,20 +769,21 @@ begin ParentForm := PControl_( Applet.ActiveControl ); if ParentForm <> nil then begin - if not ParentForm.fIsForm then - ParentForm := PControl_( Applet ); + if {$IFDEF USE_FLAGS} not(G3_IsForm in ParentForm.fFlagsG3) + {$ELSE} not ParentForm.fIsForm {$ENDIF} then + ParentForm := PControl_( Applet ); end; - if ParentForm <> nil then - DialogForm.StayOnTop := ParentForm.StayOnTop; + if ParentForm <> nil then + DialogForm.StayOnTop := ParentForm.StayOnTop; DialogForm.ShowModal; DialogForm.Hide; - if ParentForm <> nil then - SetForegroundWindow( ParentForm.Handle ); + if ParentForm <> nil then + SetForegroundWindow( ParentForm.Handle ); Result := DialogForm.ModalResult >= 0; - if Result then + if Result then begin - Path := IncludeTrailingPathDelimiter( - DirTree.TVItemPath( DirTree.TVSelected, '\' ) ); + Path := IncludeTrailingPathDelimiter( + DirTree.TVItemPath( DirTree.TVSelected, '\' ) ); end; end; @@ -787,6 +803,17 @@ begin Result := FFindFirstFileEx; end; +function TOpenDirDialogEx.GetFindFirstFileExW: TFindFirstFileExW; +begin + if not Assigned( FFindFirstFileExW ) then + begin + k32 := GetModuleHandle( 'kernel32.dll' ); + FFindFirstFileExW := GetProcAddress( k32, 'FindFirstFileExW' ); + FFindNextFileW := GetProcAddress( k32, 'FindNextFileW' ); + end; + Result := FFindFirstFileExW; +end; + {$IFDEF DIRDLGEX_LINKSPANEL} function TOpenDirDialogEx.GetLinks(idx: Integer): KOLString; begin @@ -958,8 +985,10 @@ procedure TOpenDirDialogEx.RescanNode(node: Integer); var p, s: KOLString; DL: PDirList; i, j, n, d, m, ii: Integer; - Find32: TWin32FindData; + {$IFnDEF DONTTRY_FINDFILEEXW} + Find32W: TWin32FindDataW; F: THandle; + {$ENDIF} SL: PStrListEx; disk: Char; //test: String; @@ -987,31 +1016,33 @@ begin end; if ii >= 0 then SL.AddObject( disk + ':', ii ); end; - end - else - if WinVer >= wvNT then // используется более быстрый вариант - для NT/2K/XP + end else + {$IFnDEF DONTTRY_FINDFILEEXW} + if (WinVer >= wvNT) and _FindFirstFileExW then // используется более быстрый вариант - для NT/2K/XP begin - _FindFirstFileEx; - F := FFindFirstFileEx( PKOLChar( p + '*.*' ), FindExInfoStandard, @ Find32, - FindExSearchLimitToDirectories, nil, 0 ); - if F <> INVALID_HANDLE_VALUE then - begin - TRY - while TRUE do - begin - if Find32.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then - if (Find32.cFileName <> String( '.' )) and (Find32.cFileName <> '..') then - if DoFilterAttrs( Find32.dwFileAttributes, Find32.cAlternateFileName ) then - SL.Add( Find32.cFileName ); - if not FindNextFile( F, Find32 ) then break; - end; - SL.Sort( FALSE ); - FINALLY - FindClose( F ); - END; - end; - end - else + F := FFindFirstFileExW( PWideChar( WideString( p + '*.*' ) ), + FindExInfoStandard, @ Find32W, + FindExSearchLimitToDirectories, nil, 0 ); + if F <> INVALID_HANDLE_VALUE then + begin + TRY + while TRUE do + begin + if Find32W.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0 then + if (Find32W.cFileName <> WideString( '.' )) + and (Find32W.cFileName <> '..') then + if DoFilterAttrs( Find32W.dwFileAttributes, + Find32W.cAlternateFileName ) then + SL.Add( Find32W.cFileName ); + if not FFindNextFileW( F, @Find32W ) then break; + end; + SL.Sort( FALSE ); + FINALLY + FindClose( F ); + END; + end; + end else + {$ENDIF} begin DL := NewDirListEx( p, '*.*;*', FILE_ATTRIBUTE_DIRECTORY ); TRY @@ -1059,12 +1090,12 @@ begin DeleteNode( d ); end; if i >= SL.Count then break; - if (n <> 0) and - (AnsiCompareStrNoCase( SL.Items[ i ], DirTree.TVItemText[ n ] ) = 0) then + if (n <> 0) and + (AnsiCompareStrNoCase( SL.Items[ i ], DirTree.TVItemText[ n ] ) = 0) then begin - DirTree.TVItemData[ n ] := nil; // сброс флажка "дочерние проверены" - n := DirTree.TVItemNext[ n ]; // переход к следующему узлу дерева - continue; + DirTree.TVItemData[ n ] := nil; // сброс флажка "дочерние проверены" + n := DirTree.TVItemNext[ n ]; // переход к следующему узлу дерева + continue; end; // остается случай, когда (новое) имя директории меньше чем имя в // очередном узле (или узлы исчерпаны): надо добавить его перед этим узлом @@ -1074,13 +1105,12 @@ begin else begin m := DirTree.TVItemPrevious[ n ]; - if m = 0 then - m := DirTree.TVInsert( node, TVI_FIRST, SL.Items[ i ] ) - else - m := DirTree.TVInsert( node, m, SL.Items[ i ] ); + if m = 0 then + m := DirTree.TVInsert( node, TVI_FIRST, SL.Items[ i ] ) + else m := DirTree.TVInsert( node, m, SL.Items[ i ] ); end; - if (SL.Objects[ i ] = 1) and FastScan then - SL.Objects[ i ] := 2; + if (SL.Objects[ i ] = 1) and FastScan then + SL.Objects[ i ] := 2; CASE SL.Objects[ i ] OF 0{,1}: ii := FileIconSystemIdx( p + SL.Items[ i ] + '\' ); 1: ii := DirIconSysIdxOffline( p + SL.Items[ i ] + '\' ); @@ -1285,4 +1315,9 @@ begin end; {$ENDIF DIRDLGEX_LINKSPANEL} +function TOpenDirDialogEx._FindFirstFileExW: Boolean; +begin + Result := Assigned( GetFindFirstFileExW( ) ); +end; + end. diff --git a/KOL_ASM.inc b/KOL_ASM.inc index 65aaf6f..0b3425d 100644 --- a/KOL_ASM.inc +++ b/KOL_ASM.inc @@ -1,6 +1,7 @@ //------------------------------------------------------------------------------ // KOL_ASM.inc ()to be inlude in KOL.pas) -// v 2.93 +// v 3.00 + function MsgBox( const S: KOLString; Flags: DWORD ): DWORD; asm PUSH EDX @@ -8,7 +9,9 @@ asm MOV ECX, [Applet] XOR EAX, EAX + {$IFDEF SAFE_CODE} JECXZ @@1 + {$ENDIF} {$IFDEF SNAPMOUSE2DFLTBTN} PUSHAD XCHG EAX, ECX @@ -38,7 +41,9 @@ asm {$ENDIF} {$IFDEF SNAPMOUSE2DFLTBTN} MOV ECX, [Applet] + {$IFDEF SAFE_CODE} JECXZ @@2 + {$ENDIF} PUSH EAX XCHG EAX, ECX MOV EDX, offset[WndProcSnapMouse2DfltBtn] @@ -93,6 +98,41 @@ asm POP ESI end; +function OffsetPoint( const T: TPoint; dX, dY: Integer ): TPoint; +asm + ADD EDX, [EAX].TPoint.X + ADD ECX, [EAX].TPoint.Y + MOV EAX, [Result] + MOV [EAX].TPoint.X, EDX + MOV [EAX].TPoint.Y, ECX +end; + +function OffsetSmallPoint( const T: TSmallPoint; dX, dY: SmallInt ): TSmallPoint; +asm + SHL EDX, 16 + SHLD ECX, EDX, 16 + CALL @@1 +@@1: + ROL EAX, 16 + ROL ECX, 16 + ADD AX, CX +end; + +function Point2SmallPoint( const T: TPoint ): TSmallPoint; +asm + XCHG EDX, EAX + MOV EAX, [EDX].TPoint.Y-2 + MOV AX, word ptr [EDX].TPoint.X +end; + +function SmallPoint2Point( const T: TSmallPoint ): TPoint; +asm + MOVSX ECX, AX + MOV [EDX].TPoint.X, ECX + SAR EAX, 16 + MOV [EDX].TPoint.Y, EAX +end; + function MakePoint( X, Y: Integer ): TPoint; asm MOV ECX, @Result @@ -100,6 +140,12 @@ asm MOV [ECX].TPoint.y, EDX end; +function MakeSmallPoint( X, Y: Integer ): TSmallPoint; +asm + SHL EAX, 16 + SHRD EAX, EDX, 16 +end; + function MakeFlags( FlgSet: PDWORD; FlgArray: array of Integer): Integer; asm PUSH EBX @@ -212,40 +258,6 @@ asm end; {$ENDIF} -{procedure TObj.Final; -asm //cmd //opd - XOR ECX, ECX - XCHG ECX, [EAX].fOnDestroy.TMethod.Code - JECXZ @@doAutoFree - PUSH EAX - XCHG EDX, EAX - MOV EAX, [EDX].fOnDestroy.TMethod.Data - CALL ECX - POP EAX -@@doAutoFree: - XOR ECX, ECX - XCHG ECX, [EAX].fAutoFree - JECXZ @@exit - PUSH ESI - PUSH ECX - MOV ESI, [ECX].TList.fItems - MOV ECX, [ECX].TList.fCount - SHR ECX, 1 - //JZ @@eloop // should not occur! (when fAutoFree.Count = 0, it is freeing) -@@freeloop: - MOV EDX, [ESI+ECX*8-8] - MOV EAX, [ESI+ECX*8-4] - PUSH ECX - CALL EDX - POP ECX - LOOP @@freeloop -@@eloop: - POP EAX - CALL TObj.Free - POP ESI -@@exit: -end;} - procedure TObj.Add2AutoFree(Obj: PObj); asm //cmd //opd PUSH EBX @@ -327,16 +339,18 @@ end; procedure TList.SetCapacity( Value: Integer ); asm {$IFDEF TLIST_FAST} + CMP [EAX].fUseBlocks, 0 + JZ @@old + CMP [EAX].fBlockList, 0 + JZ @@old + XOR ECX, ECX MOV CH, 1 CMP EDX, ECX JLE @@256 MOV EDX, ECX @@256: - CMP [EAX].fUseBlocks, 0 - JZ @@old - CMP [EAX].fBlockList, 0 - JZ @@old + @@just_set: MOV [EAX].fCapacity, EDX RET @@ -534,6 +548,121 @@ asm end; {$ENDIF} +procedure TList.Put( Idx: Integer; Value: Pointer ); +asm + TEST EDX, EDX + JL @@exit + CMP EDX, [EAX].fCount + JGE @@exit + PUSH ESI + MOV ESI, ECX + {$IFDEF TLIST_FAST} + CMP [EAX].fUseBlocks, 0 + JZ @@old + MOV ECX, [EAX].fBlockList + JECXZ @@old + PUSH EBX + PUSH ESI + PUSH EDI + PUSH EBP + XCHG EBX, EAX // EBX == @Self + XOR ECX, ECX // CountBefore := 0; + XOR EAX, EAX // i := 0; + CMP [EBX].fLastKnownBlockIdx, 0 + JLE @@1 + CMP EDX, [EBX].fLastKnownCountBefore + JL @@1 + MOV ECX, [EBX].fLastKnownCountBefore + MOV EAX, [EBX].fLastKnownBlockIdx +@@1: + MOV ESI, [EBX].fBlockList + MOV ESI, [ESI].fItems + MOV EDI, [ESI+EAX*8] // EDI = BlockStart + MOV ESI, [ESI+EAX*8+4] // ESI = CountCurrent + CMP ECX, EDX + JG @@next + LEA EBP, [ECX+ESI] + CMP EDX, EBP + JGE @@next + MOV [EBX].fLastKnownBlockIdx, EAX + MOV [EBX].fLastKnownCountBefore, ECX + SUB EDX, ECX + LEA EAX, [EDI+EDX*4] + POP EBP + POP EDI + POP ESI + POP EBX + MOV [EAX], ESI + POP ESI + RET +@@next: + ADD ECX, ESI + INC EAX + JMP @@1 +@@old: + {$ENDIF} + MOV EAX, [EAX].fItems + MOV [EAX+EDX*4], ESI + POP ESI +@@exit: +end; + +function TList.Get( Idx: Integer ): Pointer; +asm + TEST EDX, EDX + JL @@ret_nil + CMP EDX, [EAX].fCount + JGE @@ret_nil + {$IFDEF TLIST_FAST} + CMP [EAX].fUseBlocks, 0 + JZ @@old + MOV ECX, [EAX].fBlockList + JECXZ @@old + PUSH EBX + PUSH ESI + PUSH EDI + PUSH EBP + XCHG EBX, EAX // EBX == @Self + XOR ECX, ECX // CountBefore := 0; + XOR EAX, EAX // i := 0; + CMP [EBX].fLastKnownBlockIdx, 0 + JLE @@1 + CMP EDX, [EBX].fLastKnownCountBefore + JL @@1 + MOV ECX, [EBX].fLastKnownCountBefore + MOV EAX, [EBX].fLastKnownBlockIdx +@@1: + MOV ESI, [EBX].fBlockList + MOV ESI, [ESI].fItems + MOV EDI, [ESI+EAX*8] // EDI = BlockStart + MOV ESI, [ESI+EAX*8+4] // ESI = CountCurrent + CMP ECX, EDX + JG @@next + LEA EBP, [ECX+ESI] + CMP EDX, EBP + JGE @@next + MOV [EBX].fLastKnownBlockIdx, EAX + MOV [EBX].fLastKnownCountBefore, ECX + SUB EDX, ECX + MOV EAX, [EDI+EDX*4] + POP EBP + POP EDI + POP ESI + POP EBX + RET +@@next: + ADD ECX, ESI + INC EAX + JMP @@1 +@@old: + {$ENDIF} + MOV EAX, [EAX].fItems + MOV EAX, [EAX+EDX*4] + RET +@@ret_nil: + XOR EAX, EAX +end; + function TList.Last: Pointer; asm //cmd //opd MOV ECX, [EAX].fCount @@ -586,7 +715,8 @@ asm // // XCHG EAX, ECX JE @@1 XCHG EAX, ECX -@@2: PUSH EBX +@@2: {$IFDEF STORE_fTmpBrushColorRGB} + PUSH EBX XCHG EBX, EAX MOV ECX, [EBX].TControl.fTmpBrush JECXZ @@3 @@ -608,7 +738,21 @@ asm // // CALL CreateSolidBrush MOV [EBX].TControl.fTmpBrush, EAX @@4: POP EBX - {$ENDIF SMALLEST_CODE} + {$ELSE} + XCHG ECX, EAX + MOV EAX, [ECX].TControl.fTmpBrush + TEST EAX, EAX + JNZ @@ret_EAX + PUSH ECX + MOV EAX, [ECX].TControl.fColor + CALL Color2RGB + PUSH EAX + CALL CreateSolidBrush + POP ECX + MOV [ECX].TControl.fTmpBrush, EAX +@@ret_EAX: + {$ENDIF not STORE_fTmpBrushColorRGB} + {$ENDIF not SMALLEST_CODE} end; function NewBrush: PGraphicTool; @@ -655,7 +799,7 @@ function Color2RGB( Color: TColor ): TColor; asm BTR EAX, 31 JNC @@exit - AND EAX , $7F // <- a Fix Hallif + AND EAX , $7F // <- a Fix Hallif PUSH EAX CALL GetSysColor @@exit: @@ -2010,7 +2154,7 @@ asm CALL Windows.RoundRect end; -procedure TCanvas.TextArea(const Text: AnsiString; var Sz: TSize; +procedure TCanvas.TextArea(const Text: KOLString; var Sz: TSize; var P0: TPoint); asm PUSH EBX @@ -2304,6 +2448,7 @@ asm //cmd //opd POP EBX end; +{$IFDEF ASM_UNICODE} function Int2Hex( Value : DWord; Digits : Integer ) : AnsiString; asm // EAX = Value // EDX = Digits @@ -2422,6 +2567,7 @@ asm @@exit: XCHG EAX, EDX POP ESI end; +{$ENDIF} function cHex2Int( const Value : AnsiString) : Integer; asm @@ -2439,6 +2585,7 @@ asm @@exit: end; +{$IFDEF ASM_UNICODE} function Int2Str( Value : Integer ) : AnsiString; asm XOR ECX, ECX @@ -2480,6 +2627,7 @@ asm POP EBX ADD ESP, 10h end; +{$ENDIF} function Int2Ths( I : Integer ) : AnsiString; asm @@ -3367,115 +3515,178 @@ function _NewTControl( AParent: PControl ): PControl; begin New( Result, CreateParented( AParent ) ); end; -//[END _NewTControl] -//[function _NewWindowed] -function _NewWindowed( AParent: PControl; ControlClassName: PKOLChar; Ctl3D: Boolean ): PControl; +function _NewWindowed( AParent: PControl; ControlClassName: PKOLChar; + Ctl3D: Boolean; ACommandActions: TCommandActionsParam ): PControl; asm PUSH EBX PUSH ESI PUSH EDI + MOV EDI, [ACommandActions] + MOV [ACommandActions], ECX // Ctl3D -> ACommandActions - PUSH ECX // Ctl3D PUSH EDX // ControlClassName MOV ESI, EAX // ESI = AParent CALL _NewTControl XCHG EBX, EAX // EBX = Result POP [EBX].TControl.fControlClassName - //INC [EBX].TControl.fWindowed // incremented in TControl.Init + //INC [EBX].TControl.fWindowed // set in TControl.Init + + {$IFDEF COMMANDACTIONS_OBJ} + MOV EAX, EDI + CMP EAX, 120 + JB @@IdxActions_Loaded + MOVZX EAX, byte ptr[EDI] +@@IdxActions_Loaded: + PUSH EAX + MOV ECX, dword ptr [AllActions_Objs + EAX*4] + JECXZ @@create_new_action + XCHG EAX, ECX + PUSH EAX + CALL TObj.RefInc + POP EAX + JMP @@action_assign + +@@create_new_action: + {$IFDEF PACK_COMMANDACTIONS} + MOV EAX, EDI + CALL NewCommandActionsObj_Packed + {$ELSE not PACK_COMMANDACTIONS} + CALL NewCommandActionsObj + + TEST EDI, EDI + JZ @@no_actions + + PUSH EAX + LEA EDX, [EAX].TCommandActionsObj.aClear + XCHG EAX, EDI + XOR ECX, ECX + MOV CL, Byte(Sizeof(TCommandActions)) + CALL Move + POP EAX + JMP @@action_assign + @@no_actions: + {$ENDIF not PACK_COMMANDACTIONS} + MOV [EAX].TCommandActionsObj.aClear, offset[ClearText] + +@@action_assign: + POP EDX + MOV dword ptr [AllActions_Objs + EDX*4], EAX + + MOV [EBX].TControl.fCommandActions, EAX + XCHG EDX, EAX + MOV EAX, EBX + CALL TControl.Add2AutoFree + + {$ELSE} + TEST EDI, EDI + JZ @@no_actions2 + LEA EDX, [EBX].TControl.fCommandActions + XCHG EAX, EDI + XOR ECX, ECX + MOV CL, Byte(Sizeof(TCommandActions)) + CALL Move + JMP @@actions_created +@@no_actions2: + MOV [EBX].TControl.fCommandActions.TCommandActions.aClear, offset[ClearText] + {$ENDIF} +@@actions_created: - POP EDX // DL = parameter Ctl3D TEST ESI, ESI JZ @@no_parent - LEA ESI, [ESI].TControl.fWndProcResizeFlicks - LEA EDI, [EBX].TControl.fWndProcResizeFlicks + (* + PUSH ESI + LEA ESI, [ESI].TControl.PP.fWndProcResizeFlicks + LEA EDI, [EBX].TControl.PP.fWndProcResizeFlicks MOVSD // fWndProcResizeFlicks MOVSD // fGotoControl - LODSB // fCtl3Dchild - STOSB - DEC AL - LODSB // fCtl3D - JZ @@passed3D - XOR EDX, EDX -@@passed3D: - XCHG EAX, EDX - STOSB // fCtl3D - + POP ESI + *) + LEA ESI, [ESI].TControl.fTextColor + LEA EDI, [EBX].TControl.fTextColor MOVSD // fTextColor MOVSD // fColor {$IFDEF SMALLEST_CODE} - {$IFDEF SMALLEST_CODE_PARENTFONT} - LODSD - XCHG EDX, EAX - XOR EAX, EAX - CALL TGraphicTool.Assign - STOSD // fFont + {$IFDEF SMALLEST_CODE_PARENTFONT} + LODSD + XCHG EDX, EAX + XOR EAX, EAX + CALL TGraphicTool.Assign + STOSD // fFont + {$ELSE} + LODSD + XOR EAX, EAX + STOSD // fFont = nil + {$ENDIF} {$ELSE} - LODSD - XOR EAX, EAX - STOSD // fFont = nil - {$ENDIF} - {$ELSE} - LODSD - XCHG EDX, EAX - XOR EAX, EAX - PUSH EDX - CALL TGraphicTool.Assign - STOSD // fFont - POP EDX - XCHG ECX, EAX - JECXZ @@no_font - MOV [ECX].TGraphicTool.fParentGDITool, EDX - MOV [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.FontChanged] - MOV [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX - MOV EAX, EBX - MOV EDX, ECX - CALL TControl.FontChanged - {$IFDEF USE_AUTOFREE4CONTROLS} - MOV EAX, EBX - MOV EDX, [EBX].TControl.fFont - CALL TControl.Add2AutoFree - {$ENDIF} + LODSD + XCHG EDX, EAX + XOR EAX, EAX + PUSH EDX + CALL TGraphicTool.Assign + STOSD // fFont + POP EDX + XCHG ECX, EAX + JECXZ @@no_font + MOV [ECX].TGraphicTool.fParentGDITool, EDX + MOV [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.FontChanged] + MOV [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX + MOV EAX, EBX + MOV EDX, ECX + CALL TControl.FontChanged + {$IFDEF USE_AUTOFREE4CONTROLS} + MOV EAX, EBX + MOV EDX, [EBX].TControl.fFont + CALL TControl.Add2AutoFree + {$ENDIF} @@no_font: {$ENDIF} {$IFDEF SMALLEST_CODE} - LODSD - XOR EAX, EAX - STOSD + LODSD + XOR EAX, EAX + STOSD {$ELSE} - LODSD - XCHG EDX, EAX - XOR EAX, EAX - PUSH EDX - CALL TGraphicTool.Assign - STOSD // fBrush - POP EDX - XCHG ECX, EAX - JECXZ @@no_brush - MOV [ECX].TGraphicTool.fParentGDITool, EDX - MOV [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.BrushChanged] - MOV [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX - MOV EAX, EBX - MOV EDX, ECX - CALL TControl.BrushChanged - {$IFDEF USE_AUTOFREE4CONTROLS} - MOV EAX, EBX - MOV EDX, [EBX].TControl.fBrush - CALL TControl.Add2AutoFree - {$ENDIF} + LODSD + XCHG EDX, EAX + XOR EAX, EAX + PUSH EDX + CALL TGraphicTool.Assign + STOSD // fBrush + POP EDX + XCHG ECX, EAX + JECXZ @@no_brush + MOV [ECX].TGraphicTool.fParentGDITool, EDX + MOV [ECX].TGraphicTool.fOnChange.TMethod.Code, offset[TControl.BrushChanged] + MOV [ECX].TGraphicTool.fOnChange.TMethod.Data, EBX + MOV EAX, EBX + MOV EDX, ECX + CALL TControl.BrushChanged + {$IFDEF USE_AUTOFREE4CONTROLS} + MOV EAX, EBX + MOV EDX, [EBX].TControl.fBrush + CALL TControl.Add2AutoFree + {$ENDIF} @@no_brush: {$ENDIF} - //skip fCanvas - LODSD + MOVSB // fMargin + LODSD // skip fClientXXXXX ADD EDI, 4 - LODSD - STOSD // fMargin + LODSB // fCtl3D_child + TEST AL, 2 + JZ @@passed3D + MOV EDX, [ACommandActions] // DL <- Ctl3D !!! + AND AL, not 1 + AND DL, 1 + OR EAX, EDX +@@passed3D: + STOSB // fCtl3D_child + @@no_parent: XCHG EAX, EBX POP EDI @@ -3490,6 +3701,11 @@ asm PUSH EDX MOV EDX, offset[FormClass] MOV CL, 1 + {$IFDEF COMMANDACTIONS_OBJ} + PUSH OTHER_ACTIONS + {$ELSE} + PUSH 0 + {$ENDIF} CALL _NewWindowed MOV EBX, EAX OR byte ptr [EBX].TControl.fClsStyle, CS_DBLCLKS @@ -3499,10 +3715,14 @@ asm MOV EAX, EBX CALL TControl.AttachProc POP EDX - INC [EBX].TControl.fSizeGrip MOV EAX, EBX CALL TControl.SetCaption - DEC WORD PTR [EBX].TControl.fIsForm + {$IFDEF USE_FLAGS} + OR [EBX].TControl.fFlagsG3, (1 shl G3_IsForm) or (1 shl G3_SizeGrip) + {$ELSE} + INC [EBX].TControl.fSizeGrip + DEC WORD PTR [EBX].TControl.fIsForm // why word? + {$ENDIF} XCHG EAX, EBX POP EBX end; @@ -3514,20 +3734,28 @@ asm PUSH EDX PUSH 0 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [ButtonActions_Packed] + {$ELSE} PUSH offset[ButtonActions] - + {$ENDIF} MOV EDX, offset[ButtonClass] MOV ECX, WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or WS_TABSTOP or BS_NOTIFY CALL _NewControl XCHG EBX, EAX - INC [EBX].TControl.fIgnoreDefault - //MOV [EBX].TControl.FCtl3D, 1 + //MOV Byte Ptr[EBX].TControl.aAutoSzX, 14 + //MOV Byte Ptr[EBX].TControl.aAutoSzY, 6 + MOV word ptr [EBX].TControl.aAutoSzX, 6 shl 8 + 14 MOV EDX, [EBX].TControl.fBoundsRect.Top ADD EDX, 22 MOV [EBX].TControl.fBoundsRect.Bottom, EDX MOV [EBX].TControl.fTextAlign, taCenter + {$IFDEF USE_FLAGS} + OR [EBX].TControl.fFlagsG5, (1 shl G5_IsButton) or (1 shl G5_IgnoreDefault) + {$ELSE} INC [EBX].TControl.fIsButton - + INC [EBX].TControl.fIgnoreDefault + {$ENDIF} POP EDX MOV EAX, EBX CALL TControl.SetCaption @@ -3547,22 +3775,10 @@ asm POP EBX {$IFDEF GRAPHCTL_XPSTYLES} - PUSH EDX - MOV DL, [EAX].TControl.fTransparent - MOV [EAX].TControl.fClassicTransparent, DL - POP EDX - - PUSH EDX PUSH EAX + MOV EDX, offset[XP_Themes_For_BitBtn] CALL Attach_WM_THEMECHANGED POP EAX - POP EDX - - PUSH EDX - PUSH EAX - CALL XP_Themes_For_BitBtn - POP EAX - POP EDX {$ENDIF} end; @@ -3608,16 +3824,25 @@ asm PUSH ECX PUSH 0 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [ButtonActions_Packed] + {$ELSE} PUSH offset[ButtonActions] + {$ENDIF} MOV EDX, offset[ButtonClass] MOV ECX, WS_VISIBLE or WS_CHILD or WS_TABSTOP or BS_OWNERDRAW or BS_NOTIFY CALL _NewControl XCHG EBX, EAX + {$IFDEF USE_FLAGS} + OR [EBX].TControl.fFlagsG5, (1 shl G5_IgnoreDefault)or(1 shl G5_IsButton)or(1 shl G5_IsBitBtn) + {$ELSE} INC [EBX].TControl.fIgnoreDefault INC [EBX].TControl.fIsButton INC [EBX].TControl.fIsBitBtn - MOV byte ptr [EBX].TControl.fCommandActions.aAutoSzX, 8 - MOV byte ptr [EBX].TControl.fCommandActions.aAutoSzY, 8 + {$ENDIF} + //MOV byte ptr [EBX].TControl.fCommandActions.aAutoSzX, 8 + //MOV byte ptr [EBX].TControl.fCommandActions.aAutoSzY, 8 + MOV word ptr [EBX].TControl.fCommandActions.aAutoSzY, $808 POP EAX MOV [EBX].TControl.fBitBtnOptions, AL MOVZX EDX, Layout @@ -3695,13 +3920,13 @@ asm JNZ @@noWidthResize @@addWRight: ADD [EBX].TControl.fBoundsRect.Right, EAX - ADD [EBX].TControl.fCommandActions.aAutoSzX, AX + ADD byte ptr [EBX].TControl.aAutoSzX, AL JMP @@noWidthResize @@addWLeft: // then ADD EAX, [EBX].TControl.fBoundsRect.Left MOV [EBX].TControl.fBoundsRect.Right, EAX - MOV byte ptr [EBX].TControl.fCommandActions.aAutoSzX, 0 + MOV byte ptr [EBX].TControl.aAutoSzX, 0 @@noWidthResize: TEST EDX, EDX JLE @@noHeightResize @@ -3711,12 +3936,12 @@ asm JNE @@addHTop @@addHBottom: ADD [EBX].TControl.fBoundsRect.Bottom, EDX - ADD [EBX].TControl.fCommandActions.aAutoSzY, DX + ADD byte ptr [EBX].TControl.aAutoSzY, DL JMP @@noHeightResize @@addHTop: ADD EDX, [EBX].TControl.fBoundsRect.Top MOV [EBX].TControl.fBoundsRect.Bottom, EDX - MOV [EBX].TControl.fCommandActions.aAutoSzY, 0 + MOV byte ptr [EBX].TControl.aAutoSzY, 0 @@noHeightResize: POP ECX POP EAX @@ -3726,16 +3951,16 @@ asm JNZ @@noBorderResize JECXZ @@noBorderWinc ADD [EBX].TControl.fBoundsRect.Right, EDX - CMP [EBX].TControl.fCommandActions.aAutoSzX, 0 + CMP [EBX].TControl.aAutoSzX, 0 JZ @@noBorderWinc - ADD [EBX].TControl.fCommandActions.aAutoSzX, DX + ADD [EBX].TControl.aAutoSzX, DL @@noBorderWinc: TEST EAX, EAX JLE @@noBorderResize ADD [EBX].TControl.fBoundsRect.Bottom, EDX - CMP [EBX].TControl.fCommandActions.aAutoSzY, 0 + CMP [EBX].TControl.aAutoSzY, 0 JZ @@noBorderResize - ADD [EBX].TControl.fCommandActions.aAutoSzY, DX + ADD [EBX].TControl.aAutoSzY, DL @@noBorderResize: @@noGlyphWH: MOV ECX, [EBX].TControl.fParent @@ -3760,27 +3985,14 @@ asm POP EBX {$IFDEF GRAPHCTL_XPSTYLES} - PUSH EDX - MOV DL, [EAX].TControl.fTransparent - MOV [EAX].TControl.fClassicTransparent, DL - POP EDX - - PUSH EDX PUSH EAX + MOV EDX, offset[XP_Themes_For_BitBtn] CALL Attach_WM_THEMECHANGED POP EAX - POP EDX - - PUSH EDX - PUSH EAX - CALL XP_Themes_For_BitBtn - POP EAX - POP EDX {$ENDIF} end; {$ENDIF BITBTN_ASM} - function NewCheckbox( AParent: PControl; const Caption: KOLString ): PControl; asm CALL NewButton @@ -3788,81 +4000,56 @@ asm ADD EDX, 72 MOV [EAX].TControl.fBoundsRect.Right, EDX MOV [EAX].TControl.fStyle, WS_VISIBLE or WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP or BS_NOTIFY - MOV [EAX].TControl.fCommandActions.aAutoSzX, 24 + MOV [EAX].TControl.aAutoSzX, 24 {$IFDEF GRAPHCTL_XPSTYLES} - PUSH EDX - MOV DL, [EAX].TControl.fTransparent - MOV [EAX].TControl.fClassicTransparent, DL - POP EDX - - PUSH EDX PUSH EAX + MOV EDX, offset[XP_Themes_For_CheckBox] CALL Attach_WM_THEMECHANGED POP EAX - POP EDX - - PUSH EDX - PUSH EAX - CALL XP_Themes_For_CheckBox - POP EAX - POP EDX {$ENDIF} end; -procedure ClickRadio( Sender:PObj ); -asm - MOV ECX, [EAX].TControl.fParent - JECXZ @@exit - PUSH [EAX].TControl.fMenu - PUSH [ECX].TControl.fRadioLast - PUSH [ECX].TControl.fRadio1st - PUSH [ECX].TControl.fHandle - CALL CheckRadioButton -@@exit: -end; - function NewRadiobox( AParent: PControl; const Caption: KOLString ): PControl; const RadioboxStyles = WS_VISIBLE or WS_CHILD or BS_RADIOBUTTON or WS_TABSTOP or WS_GROUP or BS_NOTIFY; asm PUSH EBX - PUSH EAX + PUSH ESI + MOV ESI, EAX CALL NewCheckbox XCHG EBX, EAX MOV [EBX].TControl.fStyle, RadioboxStyles - MOV [EBX].TControl.fControlClick, offset[ClickRadio] - POP ECX - JECXZ @@exit - MOV EDX, [EBX].TControl.fMenu - MOV [ECX].TControl.fRadioLast, EDX - MOV EAX, [ECX].TControl.fRadio1st + MOV [EBX].TControl.PP.fControlClick, offset[ClickRadio] + TEST ESI, ESI + JZ @@exit + MOV ECX, [EBX].TControl.fMenu + PUSH ECX + MOV EDX, offset[RADIO_LAST] + MOV EAX, ESI + CALL TControl.Set_Prop_Int + MOV EDX, offset[RADIO_1ST] + PUSH EDX + MOV EAX, ESI + CALL TControl.Get_Prop_Int TEST EAX, EAX + POP EDX + POP ECX JNZ @@exit - MOV [ECX].TControl.fRadio1st, EDX + MOV EAX, ESI + CALL TControl.Set_Prop_Int MOV EAX, EBX CALL TControl.SetRadioChecked @@exit: XCHG EAX, EBX + POP ESI POP EBX - + {$IFDEF GRAPHCTL_XPSTYLES} - PUSH EDX - MOV DL, [EAX].TControl.fTransparent - MOV [EAX].TControl.fClassicTransparent, DL - POP EDX - - PUSH EDX PUSH EAX + MOV EDX, offset[XP_Themes_For_RadioBox] CALL Attach_WM_THEMECHANGED POP EAX - POP EDX - - PUSH EDX - PUSH EAX - CALL XP_Themes_For_RadioBox - POP EAX - POP EDX {$ENDIF} end; @@ -3872,7 +4059,11 @@ asm MOV EDX, [EAX].TControl.fBoundsRect.Top ADD EDX, 44 MOV [EAX].TControl.fBoundsRect.Bottom, EDX + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG1, (1 shl G1_WordWrap) + {$ELSE} INC [EAX].TControl.fWordWrap + {$ENDIF} AND byte ptr [EAX].TControl.fStyle, not SS_LEFTNOWORDWRAP end; @@ -3885,7 +4076,11 @@ asm XOR EDX, EDX CALL NewLabel MOV EBX, EAX + {$IFDEF USE_FLAGS} + AND [EBX].TControl.fFlagsG1, not(1 shl G1_IsStaticControl) + {$ELSE} DEC [EBX].TControl.fIsStaticControl // снова 0 ! + {$ENDIF USE_FLAGS} MOV EDX, offset[WndProcLabelEffect] CALL TControl.AttachProc @@ -3898,10 +4093,14 @@ asm CALL TControl.AttachProc MOV [EBX].TControl.fTextAlign, taCenter MOV [EBX].TControl.fTextColor, clWindowText - POP [EBX].TControl.fShadowDeep + POP [EBX].TControl.DF.fShadowDeep + {$IFDEF USE_FLAGS} + OR [EBX].TControl.fFlagsG1, (1 shl G1_IgnoreWndCaption) + {$ELSE} INC [EBX].TControl.fIgnoreWndCaption + {$ENDIF USE_FLAGS} ADD [EBX].TControl.fBoundsRect.Bottom, 40 - 22 - MOV [EBX].TControl.fColor2, clNone + MOV [EBX].TControl.DF.fColor2, clNone XCHG EAX, EBX POP EBX @@ -3920,7 +4119,11 @@ asm // // {$IFDEF SMALLEST_CODE} {$ELSE} CALL TControl.CreateChildWindows + {$IFDEF USE_FLAGS} + TEST [EBX].TControl.fFlagsG2, (1 shl G2_Transparent) + {$ELSE} CMP [EBX].TControl.fTransparent, 0 + {$ENDIF USE_FLAGS} JNE @@exit {$ENDIF} @@ -4040,7 +4243,7 @@ asm INC EDI @@mReady: MOV EDX, [EBX].TControl.fParent - MOV EBP, [EDX].TControl.fMargin + MOVSX EBP, [EDX].TControl.fMargin NEG EBP {$IFDEF PARANOIA} DB $A8, chkTop or chkBott {$ELSE} TEST AL, chkTop or chkBott {$ENDIF} // fAlign in [ caTop, caBottom ] ? XCHG EAX, EDX @@ -4214,26 +4417,30 @@ asm @@no_caTop_caBottom: CALL TControl.GetWidth @@caTop_caBottom: - MOV [EBX].TControl.fSplitStartSize, EAX - MOV ECX, [EBX].TControl.fSecondControl + MOV [EBX].TControl.DF.fSplitStartSize, EAX + MOV ECX, [EBX].TControl.DF.fSecondControl JECXZ @@noSecondControl1 XCHG EAX, ECX PUSH EAX CALL TControl.GetWidth - MOV [EBX].TControl.fSplitStartPos2.x, EAX + MOV [EBX].TControl.DF.fSplitStartPos2.x, EAX POP EAX CALL TControl.GetHeight - MOV [EBX].TControl.fSplitStartPos2.y, EAX + MOV [EBX].TControl.DF.fSplitStartPos2.y, EAX @@noSecondControl1: PUSH [EBX].TControl.fHandle CALL SetCapture + {$IFDEF USE_FLAGS} + OR [EBX].TControl.fFlagsG6, 1 shl G6_Dragging + {$ELSE} OR [EBX].TControl.fDragging, 1 + {$ENDIF} PUSH 0 PUSH 100 PUSH $7B PUSH [EBX].TControl.fHandle CALL SetTimer - LEA EAX, [EBX].TControl.fSplitStartPos + LEA EAX, [EBX].TControl.DF.fSplitStartPos PUSH EAX CALL GetCursorPos JMP @@exit @@ -4255,7 +4462,11 @@ asm @@noWM_LBUTTONUP: CMP word ptr[EDX].TMsg.message, WM_TIMER JNE @@exit + {$IFDEF USE_FLAGS} + TEST [EBX].TControl.fFlagsG6, 1 shl G6_Dragging + {$ELSE} CMP [EBX].TControl.fDragging, 0 + {$ENDIF} JE @@exit PUSH VK_ESCAPE CALL GetAsyncKeyState @@ -4271,7 +4482,11 @@ asm {$ENDIF} @@killtimer: + {$IFDEF USE_FLAGS} + AND [EBX].TControl.fFlagsG6, $7F //not(1 shl G6_Dragging) + {$ELSE} MOV [EBX].TControl.fDragging, 0 + {$ENDIF} PUSH $7B PUSH [EBX].TControl.fHandle CALL KillTimer @@ -4293,9 +4508,13 @@ asm MOV DL, EdgeStyle CALL NewPanel XCHG EBX, EAX - POP [EBX].TControl.fSplitMinSize1 - POP [EBX].TControl.fSplitMinSize2 + POP [EBX].TControl.DF.fSplitMinSize1 + POP [EBX].TControl.DF.fSplitMinSize2 + {$IFDEF USE_FLAGS} + MOV [EBX].TControl.fFlagsG5, 1 shl G5_IsSplitter + {$ELSE} INC [EBX].TControl.fIsSplitter + {$ENDIF} XOR EDX, EDX MOV DL, 4 MOV EAX, [EBX].TControl.fBoundsRect.Left @@ -4338,22 +4557,10 @@ asm POP EBX {$IFDEF GRAPHCTL_XPSTYLES} - PUSH EDX - MOV DL, [EAX].TControl.fTransparent - MOV [EAX].TControl.fClassicTransparent, DL - POP EDX - - PUSH EDX PUSH EAX + MOV EDX, offset[XP_Themes_For_Splitter] CALL Attach_WM_THEMECHANGED POP EAX - POP EDX - - PUSH EDX - PUSH EAX - CALL XP_Themes_For_Splitter - POP EAX - POP EDX {$ENDIF} end; @@ -4367,8 +4574,8 @@ asm MOV EDX, offset[WndProcGradient] CALL TControl.AttachProc POP EAX - POP [EAX].TControl.fColor1 - POP [EAX].TControl.fColor2 + POP [EAX].TControl.DF.fColor1 + POP [EAX].TControl.DF.fColor2 ADD [EAX].TControl.fBoundsRect.Right, 40-64 ADD [EAX].TControl.fBoundsRect.Bottom, 40 - 22 end; @@ -4384,14 +4591,14 @@ asm MOV EDX, offset[WndProcGradientEx] CALL TControl.AttachProc POP EAX - POP [EAX].TControl.fColor1 - POP [EAX].TControl.fColor2 + POP [EAX].TControl.DF.fColor1 + POP [EAX].TControl.DF.fColor2 ADD [EAX].TControl.fBoundsRect.Right, 40-100 ADD [EAX].TControl.fBoundsRect.Bottom, 40 - 22 MOV DL, Style - MOV [EAX].TControl.fGradientStyle, DL + MOV [EAX].TControl.DF.fGradientStyle, DL MOV DL, Layout - MOV [EAX].TControl.fGradientLayout, DL + MOV [EAX].TControl.DF.fGradientLayout, DL end; const EditClass: array[0..4] of KOLChar = ( 'E','D','I','T',#0 ); @@ -4416,11 +4623,16 @@ asm AND ECX, WS_clear @@1: OR ECX, WS_flags PUSH 1 - PUSH offset [EditActions] - MOV EDX, offset [EditClass] + {$IFDEF PACK_COMMANDACTIONS} + PUSH [EditActions_Packed] + {$ELSE} + PUSH offset[EditActions] + {$ENDIF} + MOV EDX, offset[EditClass] XCHG EAX, EBX CALL _NewControl XCHG EBX, EAX + MOV Byte Ptr [EBX].TControl.aAutoSzY, 6 LEA ECX, [EBX].TControl.fBoundsRect MOV EDX, [ECX].TRect.Left ADD EDX, 100 @@ -4435,7 +4647,11 @@ asm ADD [ECX].TRect.Right, 100 ADD [ECX].TRect.Bottom, 200 - 22 MOV DL, 1 + {$IFDEF USE_FLAGS} + OR [EBX].TControl.fFlagsG5, 1 shl G5_IgnoreDefault + {$ELSE} INC [EBX].TControl.fIgnoreDefault + {$ENDIF} @@2: TEST AH, 4 JZ @@3 @@ -4490,9 +4706,20 @@ asm CALL SetWindowPos DEC ESI JZ @@3 - MOV ECX, [EBX].TControl.fOnDropDown.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EBX].TControl.EV + MOV ECX, [EAX].TEvents.fOnDropDown.TMethod.Code + {$ELSE} + MOV ECX, [EBX].TControl.EV.fOnDropDown.TMethod.Code + {$ENDIF} + {$IFDEF NIL_EVENTS} JECXZ @@exit - MOV EAX, [EBX].TControl.fOnDropDown.TMethod.Data + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TEvents.fOnDropDown.TMethod.Data + {$ELSE} + MOV EAX, [EBX].TControl.EV.fOnDropDown.TMethod.Data + {$ENDIF} MOV EDX, EBX CALL ECX @@exit: POP ESI @@ -4515,7 +4742,11 @@ asm XCHG ECX, EAX POP EAX PUSH 1 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [ComboActions_Packed] + {$ELSE} PUSH offset[ComboActions] + {$ENDIF} MOV EDX, offset[ComboboxClass] OR ECX, WS_VISIBLE or WS_CHILD or WS_VSCROLL or CBS_HASSTRINGS or WS_TABSTOP TEST ECX, CBS_SIMPLE @@ -4523,8 +4754,12 @@ asm OR ECX, CBS_DROPDOWN @@O: CALL _NewControl - MOV [EAX].TControl.fCreateWndExt, offset[CreateComboboxWnd] - MOV [EAX].TControl.fDropDownProc, offset[ComboboxDropDown] + {$IFDEF PACK_COMMANDACTIONS} + MOV EDX, [EAX].TControl.fCommandActions + MOV [EDX].TCommandActionsObj.aClear, offset[ClearCombobox] + {$ENDIF} + MOV Byte Ptr [EAX].TControl.aAutoSzY, 6 + MOV [EAX].TControl.PP.fCreateWndExt, offset[CreateComboboxWnd] OR byte ptr [EAX].TControl.fClsStyle, CS_DBLCLKS ADD [EAX].TControl.fBoundsRect.Right, 100-64 ADD [EAX].TControl.fBoundsRect.Bottom, 22-64 @@ -4556,7 +4791,11 @@ end; function NewProgressbar( AParent: PControl ): PControl; asm PUSH 1 + {$IFDEF COMMANDACTIONS_OBJ} + PUSH PROGRESS_ACTIONS + {$ELSE} PUSH 0 + {$ENDIF} MOV EDX, offset[Progress_class] MOV ECX, WS_CHILD or WS_VISIBLE CALL _NewCommonControl @@ -4570,7 +4809,12 @@ asm XOR EDX, EDX MOV [EAX].TControl.fMenu, EDX MOV [EAX].TControl.fTextColor, clHighlight + {$IFDEF COMMANDACTIONS_OBJ} //todo: should be used separate Actions record + MOV ECX, [EAX].TControl.fCommandActions + MOV [ECX].TCommandActionsObj.aSetBkColor, PBM_SETBKCOLOR + {$ELSE} MOV [EAX].TControl.fCommandActions.aSetBkColor, PBM_SETBKCOLOR + {$ENDIF} end; function NewProgressbarEx( AParent: PControl; Options: TProgressbarOptions ): PControl; @@ -4638,27 +4882,60 @@ asm JZ @@click CMP EDX, NM_RCLICK JNE @@chk_killfocus + {$IFDEF USE_FLAGS} + MOV CL, G6_RightClick + {$ELSE} INC ECX + {$ENDIF} @@click: + {$IFDEF USE_FLAGS} + AND [EAX].TControl.fFlagsG6, not(1 shl G6_RightClick) + OR [EAX].TControl.fFlagsG6, CL + {$ELSE} MOV [EAX].TControl.fRightClick, CL + {$ENDIF} - MOV ECX, [EAX].TControl.fOnClick.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TControl.EV + MOV ECX, [EAX].TEvents.fOnClick.TMethod.Code + {$ELSE} + MOV ECX, [EAX].TControl.EV.fOnClick.TMethod.Code + {$ENDIF} + {$IFDEF NIL_EVENTS} JECXZ @@fin_false - MOV EDX, [EAX].TControl.fOnClick.TMethod.Data + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + MOV EDX, [EAX].TEvents.fOnClick.TMethod.Data + {$ELSE} + MOV EDX, [EAX].TControl.EV.fOnClick.TMethod.Data + {$ENDIF} JMP @@fin_event +{$IFDEF NIL_EVENTS} @@fin_false: POP EBX @@ret_false: XOR EAX, EAX RET +{$ENDIF} @@chk_killfocus: CMP EDX, NM_KILLFOCUS JNE @@chk_setfocus - MOV ECX, [EAX].TControl.fOnLeave.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TControl.EV + MOV ECX, [EAX].TEvents.fOnLeave.TMethod.Code + {$ELSE} + MOV ECX, [EAX].TControl.EV.fOnLeave.TMethod.Code + {$ENDIF} + {$IFDEF NIL_EVENTS} JECXZ @@fin_false - MOV EDX, [EAX].TControl.fOnLeave.TMethod.Data + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + MOV EDX, [EAX].TEvents.fOnLeave.TMethod.Data + {$ELSE} + MOV EDX, [EAX].TControl.EV.fOnLeave.TMethod.Data + {$ENDIF} JMP @@fin_event @@chk_setfocus: CMP EDX, NM_RETURN @@ -4667,22 +4944,45 @@ asm JNE @@fin_false @@set_focus: - MOV ECX, [EAX].TControl.fOnEnter.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TControl.EV + MOV ECX, [EAX].TEvents.fOnEnter.TMethod.Code + {$ELSE} + MOV ECX, [EAX].TControl.EV.fOnEnter.TMethod.Code + {$ENDIF} + {$IFDEF NIL_EVENTS} JECXZ @@fin_false - MOV EDX, [EAX].TControl.fOnEnter.TMethod.Data + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + MOV EDX, [EAX].TEvents.fOnEnter.TMethod.Data + {$ELSE} + MOV EDX, [EAX].TControl.EV.fOnEnter.TMethod.Data + {$ENDIF} @@fin_event: XCHG EAX, EDX CALL ECX +{$IFnDEF NIL_EVENTS} +@@fin_false: +{$ENDIF} POP EBX - MOV AL, 1 +{$IFnDEF NIL_EVENTS} +@@ret_false: +{$ENDIF} + //MOV AL, 1 + XOR EAX, EAX end; procedure ApplyImageLists2Control( Sender: PControl ); asm PUSHAD XCHG ESI, EAX + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [ESI].TControl.fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aSetImgList + {$ELSE} MOVZX ECX, [ESI].TControl.fCommandActions.aSetImgList + {$ENDIF} JECXZ @@fin MOV EBP, ECX XOR EBX, EBX @@ -4717,7 +5017,7 @@ asm PUSHAD XCHG ESI, EAX - PUSH dword ptr [ESI].TControl.fLVOptions + PUSH dword ptr [ESI].TControl.DF.fLVOptions MOV EAX, ESP MOV EDX, offset[ListViewFlags] XOR ECX, ECX @@ -4731,7 +5031,7 @@ asm AND DX, not $403F OR EDX, EAX - MOVZX EAX, [ESI].TControl.fLVStyle + MOVZX EAX, [ESI].TControl.DF.fLVStyle OR EDX, [EAX*4 + offset ListViewStyles] MOV EAX, ESI @@ -4763,9 +5063,18 @@ asm OR ECX, LVS_SHAREIMAGELISTS or WS_CHILD or WS_VISIBLE or WS_TABSTOP MOV EDX, offset[WC_LISTVIEW] PUSH 1 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [ListViewActions_Packed] + {$ELSE} PUSH offset[ListViewActions] + {$ENDIF} CALL _NewCommonControl + {$IFDEF PACK_COMMANDACTIONS} + MOV EDX, [EAX].TControl.fCommandActions + MOV [EDX].TCommandActionsObj.aClear, offset[ClearListView] + {$ENDIF} + MOV EDX, ESP PUSH EAX XCHG EAX, EDX @@ -4780,10 +5089,10 @@ asm OR EDX, ECX MOV [EAX].TControl.fStyle, EDX - POP [EAX].TControl.fLVOptions + POP [EAX].TControl.DF.fLVOptions POP EDX - MOV [EAX].TControl.fLVStyle, DL - MOV [EAX].TControl.fCreateWndExt, offset[ApplyImageLists2ListView] + MOV [EAX].TControl.DF.fLVStyle, DL + MOV [EAX].TControl.PP.fCreateWndExt, offset[ApplyImageLists2ListView] ADD [EAX].TControl.fBoundsRect.Right, 200-64 ADD [EAX].TControl.fBoundsRect.Bottom, 150-64 MOV ECX, [ImageListState] @@ -4801,7 +5110,7 @@ asm PUSH EAX CALL TControl.SetImgListIdx POP EAX - MOV [EAX].TControl.fLVTextBkColor, clWindow + MOV [EAX].TControl.DF.fLVTextBkColor, clWindow XOR EDX, EDX INC EDX MOV [EAX].TControl.fLookTabKeys, DL @@ -4825,10 +5134,18 @@ asm //cmd //opd POP EAX MOV EDX, offset[WC_TREEVIEW] PUSH 1 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [TreeViewActions_Packed] + {$ELSE} PUSH offset[TreeViewActions] + {$ENDIF} CALL _NewCommonControl MOV EBX, EAX - MOV [EBX].TControl.fCreateWndExt, offset[ApplyImageLists2Control] + {$IFDEF PACK_COMMANDACTIONS} + MOV EDX, [EBX].TControl.fCommandActions + MOV [EDX].TCommandActionsObj.aClear, offset[ClearTreeView] + {$ENDIF} + MOV [EBX].TControl.PP.fCreateWndExt, offset[ApplyImageLists2Control] MOV [EBX].TControl.fColor, clWindow MOV EDX, offset[WndProcTreeView] CALL TControl.AttachProc @@ -4900,10 +5217,19 @@ asm //cmd //opd POPFD JZ @@ret_false - MOV ECX, [EBX].TControl.fOnSelChange.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EBX].TControl.EV + MOV ECX, [EAX].TEvents.fOnSelChange.TMethod.Code + {$ELSE} + MOV ECX, [EBX].TControl.EV.fOnSelChange.TMethod.Code + {$ENDIF} JECXZ @@ret_false MOV EDX, EBX + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TEvents.fOnSelChange.TMethod.Data + {$ELSE} MOV EAX, [EBX].TControl.fOnSelChange.TMethod.Data + {$ENDIF} CALL ECX JMP @@ret_false @@chk_WM_SIZE: @@ -4975,10 +5301,21 @@ asm //cmd //opd CALL TControl.BringToFront POPFD JZ @@ret_false - MOV ECX, [EBX].TControl.fOnSelChange.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EBX].TControl.EV + MOV ECX, [EAX].TEvents.fOnSelChange.TMethod.Code + {$ELSE} + MOV ECX, [EBX].TControl.EV.fOnSelChange.TMethod.Code + {$ENDIF} + {$IFDEF NIL_EVENTS} JECXZ @@ret_false + {$ENDIF} MOV EDX, EBX - MOV EAX, [EBX].TControl.fOnSelChange.TMethod.Data + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TEvents.fOnSelChange.TMethod.Data + {$ELSE} + MOV EAX, [EBX].TControl.EV.fOnSelChange.TMethod.Data + {$ENDIF} CALL ECX JMP @@ret_false @@chk_WM_SIZE: @@ -4989,22 +5326,22 @@ asm //cmd //opd PUSH [EBX].TControl.fHandle CALL Windows.GetClientRect MOV EAX,[ESP].TRect.Right - MOV [EBX].TControl.fClientRight,EAX + MOV [EBX].TControl.fClientRight, AL MOV EAX,[ESP].TRect.Bottom - MOV [EBX].TControl.fClientBottom,EAX + MOV [EBX].TControl.fClientBottom, AL PUSH ESP PUSH 0 PUSH TCM_ADJUSTRECT PUSH EBX CALL TControl.Perform POP EAX - MOV [EBX].TControl.fClientLeft,EAX + MOV [EBX].TControl.fClientLeft, AL POP EAX - MOV [EBX].TControl.fClientTop,EAX + MOV [EBX].TControl.fClientTop, AL POP EAX - SUB [EBX].TControl.fClientRight,EAX + SUB [EBX].TControl.fClientRight, AL POP EAX - SUB [EBX].TControl.fClientBottom,EAX + SUB [EBX].TControl.fClientBottom, AL @@ret_false: XOR EAX, EAX POP EBX @@ -5033,7 +5370,11 @@ asm //cmd //opd XCHG EAX, EBX MOV EDX, offset[WC_TABCONTROL] PUSH 1 + {$IFDEF PACK_COMMANDACTIONS} + PUSH [TabControlActions_Packed] + {$ELSE} PUSH offset[TabControlActions] + {$ENDIF} CALL _NewCommonControl MOV EBX, EAX POP ECX //Options @@ -5062,6 +5403,7 @@ end; {$ENDIF} {$IFNDEF NOT_USE_RICHEDIT} +(* function WndProc_RE_LinkNotify( Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; asm CMP word ptr [EDX].TMsg.message, WM_NOTIFY @@ -5131,17 +5473,25 @@ asm {$ENDIF UNICODE_CTRLS} POP EDX MOV ECX, [EDX].TENLink.msg - LEA EAX, [EBX].TControl.fOnREOverURL + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EBX].TControl.EV + LEA EAX, [EAX].TEvents.fOnREOverURL + {$ELSE} + LEA EAX, [EBX].TControl.EV.fOnREOverURL + {$ENDIF} CMP ECX, WM_MOUSEMOVE JE @@Url_event - LEA EAX, [EBX].TControl.fOnREUrlClick + //LEA EAX, [EBX].TControl.EV.fOnREUrlClick + ADD EAX, 8 CMP ECX, WM_LBUTTONDOWN JE @@Url_Event CMP ECX, WM_RBUTTONDOWN JNE @@after_Url_event @@Url_event: MOV ECX, [EAX].TMethod.Code + {$IFDEF NIL_EVENTS} JECXZ @@after_Url_event + {$ENDIF} MOV EDX, EBX MOV EAX, [EAX].TMethod.Data CALL ECX @@ -5152,6 +5502,7 @@ asm @@ret_false: XOR EAX, EAX end; +*) {$ENDIF NOT_USE_RICHEDIT} function OleInit: Boolean; @@ -5189,40 +5540,100 @@ asm //cmd //opd PUSH EBX PUSH EDI MOV EBX, EAX - {$IFDEF _D2orD3} + {$IFDEF CALL_INHERITED} CALL TObj.Init // for now, TObj.Init do nothing for Delphi 4 and higher {$ENDIF} {$IFDEF USE_GRAPHCTLS} - MOV [EBX].fDoInvalidate.TMethod.Code, offset[TControl.InvalidateWindowed] - MOV [EBX].fDoInvalidate.TMethod.Data, EBX + MOV [EBX].PP.fDoInvalidate, offset[InvalidateWindowed] {$ENDIF} - MOV EAX, offset WndProcDummy - LEA EDI, [EBX].fPass2DefProc - STOSD // fPass2DefProc := WndProcDummy - STOSD // fOnDynHandlers := WndProcDummy - STOSD // fWndProcKeybd := WndProcDummy - STOSD // fControlClick := WndProcDummy - similar to DefWindowProc - STOSD // fAutoSize := WndProcDummy - similar to DefWindowProc - LEA EDI, [EBX].fWndProcResizeFlicks - STOSD - MOV [EBX].fWndFunc, offset WndFunc - MOV EDX, offset ClearText - MOV [EBX].fCommandActions.aClear, EDX + {$IFDEF OLD_EVENTS_MODEL} + MOV EAX, offset WndProcDummy + LEA EDI, [EBX].PP.fPass2DefProc + STOSD // fPass2DefProc := WndProcDummy + STOSD // fOnDynHandlers := WndProcDummy + STOSD // fWndProcKeybd := WndProcDummy + STOSD // fControlClick := WndProcDummy - similar to DefWindowProc + STOSD // fAutoSize := WndProcDummy - similar to DefWindowProc + LEA EDI, [EBX].PP.fWndProcResizeFlicks + STOSD + + MOV [EBX].PP.fWndFunc, offset WndFunc + {$ELSE NEW_EVENTS_MODEL} + {$IFDEF EVENTS_DYNAMIC} + XOR ECX, ECX + CMP DWORD PTR[EmptyEvents].TEvents.fOnMessage.TMethod.Code, ECX + JNZ @@a2 + MOV CL, idx_LastEvent+1 + @@a1: MOVZX EDX, byte ptr [ECX+InitEventsTable-1] + AND DL, $0F + MOV EDX, dword ptr [EDX*4 + DummyProcTable] + MOV dword ptr [EmptyEvents+ECX*8-8], EDX + LOOP @@a1 + @@a2: + MOV EDX, offset[EmptyEvents] + MOV [EBX].EV, EDX + MOV CL, idx_LastProc - idx_LastEvent + @@a3: + MOVZX EDX, byte ptr [ECX+InitEventsTable-1] + SHR EDX, 4 + MOV EDX, dword ptr [EDX*4 + DummyProcTable] + MOV dword ptr [EBX+ECX*4-4].PP, EDX + LOOP @@a3 + {$ELSE} + XOR ECX, ECX + MOV CL, idx_LastEvent+1 + @@1: + MOVZX EDX, byte ptr [ECX+InitEventsTable-1] + PUSH EDX + AND DL, $0F + MOV EDX, [EDX*4 + DummyProcTable] + MOV dword ptr [EBX+ECX*8-8].EV, EDX + POP EDX + SHR EDX, 4 + CMP ECX, idx_LastProc - idx_LastEvent + 1 + JGE @@2 + + MOV EDX, [EDX*4 + DummyProcTable] + MOV dword ptr [EBX+ECX*4-4].PP, EDX + @@2: + LOOP @@1 + {$ENDIF} + {$ENDIF NEW_EVENTS_MODEL} + + {$IFDEF COMMANDACTIONS_OBJ} //--- moved to _NewWindowed + //---- MOV EDX, [EBX].fCommandActions + //---- MOV [EDX].TCommandActionsObj.aClear, offset[ClearText] + {$ELSE} + //---- MOV [EBX].fCommandActions.aClear, offset[ClearText] + {$ENDIF} + {$IFDEF USE_FLAGS} + {$ELSE} INC [EBX].fWindowed + {$ENDIF} MOV [EBX].fColor, clBtnFace + {$IFDEF SYSTEMCOLORS_DELPHI} MOV [EBX].fTextColor, clWindowText and $FF + {$ELSE} + MOV [EBX].fTextColor, clWindowText + {$ENDIF} + MOV byte ptr [EBX].fMargin, 2 - INC dword ptr [EBX].fCtl3Dchild + OR dword ptr [EBX].fCtl3D_child, 3 + {$IFDEF SMALLEST_CODE} {$ELSE} - INC dword ptr [EBX].fCtl3D // anyway assigned in _NewWindowed DEC byte ptr [EBX].fAlphaBlend // has no effect until AlphaBlend changed {$ENDIF} MOV byte ptr[EBX].fClsStyle, CS_OWNDC MOV [EBX].fStyle, IniStyle INC dword ptr[EBX].fExStyle+2 + {$IFDEF USE_FLAGS} + //AND [EBX].fStyle.f3_Style, not(1 shl F3_Disabled) + OR [EBX].fStyle.f3_Style, (1 shl F3_Visible) + {$ELSE} DEC WORD PTR [EBX].fEnabled + {$ENDIF} LEA EDI, [EBX].fDynHandlers MOV EBX, offset[NewList] @@ -5239,9 +5650,7 @@ procedure CallTControlInit( Ctl: PControl ); begin Ctl.Init; end; -//[END CallTControlInit] -//[procedure TControl.InitParented] procedure TControl.InitParented( AParent: PControl ); const IStyle = WS_VISIBLE or WS_CLIPCHILDREN or WS_CLIPSIBLINGS or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or @@ -5275,9 +5684,9 @@ asm XCHG ECX, EAX JECXZ @@cur_ctl_removed MOV EDX, EBX - XOR EDX, [ECX].TControl.fCurrentControl + XOR EDX, [ECX].TControl.DF.fCurrentControl JNE @@cur_ctl_removed - MOV [ECX].TControl.fCurrentControl, EDX + MOV [ECX].TControl.DF.fCurrentControl, EDX @@cur_ctl_removed: MOV ECX, [EBX].fHandle @@ -5295,11 +5704,15 @@ asm CALL DestroyChildren {$ENDIF} + {$IFDEF USE_FLAGS} + BTS DWORD PTR [EBX].fFlagsG2, G2_Destroying + JC @@destroyed + {$ELSE} XOR ECX, ECX CMP [EBX].fDestroying, CL JNZ @@destroyed - INC [EBX].fDestroying + {$ENDIF USE_FLAGS} {$IFDEF USE_AUTOFREE4CONTROLS} XOR EAX, EAX @@ -5348,12 +5761,17 @@ asm @@img_list_destroyed: {$ENDIF} - MOV ECX, [EBX].fIcon + MOV ECX, [EBX].DF.fIcon JECXZ @@icoremoved INC ECX JZ @@icoremoved + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG1, (1 shl G1_IconShared) + JNZ @@icoremoved + {$ELSE} CMP [EBX].fIconShared, 0 JNZ @@icoremoved + {$ENDIF USE_FLAGS} DEC ECX PUSH ECX CALL DestroyIcon @@ -5373,10 +5791,10 @@ asm PUSH [EBX].fHandle CALL SetWindowLong {$ENDIF} + {$IFDEF USE_fNCDestroyed} CMP [EBX].fNCDestroyed, 0 JNZ @@destroy2 - //CMP [EBX].fIsForm, 0 - //JZ @@destroy2 + {$ENDIF USE_fNCDestroyed} PUSH [EBX].fHandle CALL DestroyWindow @@destroy2: @@ -5385,20 +5803,19 @@ asm @@free_fields: PUSH 0 + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG6, 1 shl G6_CtlClassNameChg + JZ @@notFreeCtlClsName + {$ELSE} MOVZX ECX, [EBX].fCtlClsNameChg JECXZ @@notFreeCtlClsName + {$ENDIF} PUSH [EBX].fControlClassName @@notFreeCtlClsName: - LEA ESI, [EBX].fCustomData - MOV DL, 2 -@@chkFreeLoop: - LODSD - XCHG ECX, EAX - JECXZ @@notFree1 + MOV ECX, [EBX].fCustomData + JECXZ @@notFreeCustomData PUSH ECX -@@notFree1: - DEC DL - JNZ @@chkFreeLoop +@@notFreeCustomData: @@FreeFieldsLoop: POP ECX JECXZ @@endFreeFieldsLoop @@ -5416,10 +5833,10 @@ asm MOV ECX, [EBX].fParent JECXZ @@removed_from_parent - CMP [ECX].fCurrentControl, EBX + CMP [ECX].DF.fCurrentControl, EBX JNE @@removefromParent XOR EAX, EAX - MOV [ECX].fCurrentControl, EAX + MOV [ECX].DF.fCurrentControl, EAX @@removefromParent: {$IFDEF USE_AUTOFREE4CHILDREN} PUSH ECX @@ -5475,13 +5892,16 @@ asm POP EDX CMP AL, DL JZ @@exit + {$IFDEF USE_FLAGS} + {$ELSE} MOV [EBX].fEnabled, DL + {$ENDIF USE_FLAGS} TEST EDX, EDX JNZ @@andnot - OR byte ptr [EBX].fStyle + 3, 8 + OR [EBX].fStyle.f3_Style, (1 shl F3_Disabled) JMP @@1 @@andnot: - AND byte ptr [EBX].fStyle + 3, $F7 + AND [EBX].fStyle.f3_Style, not(1 shl F3_Disabled) @@1: MOV ECX, [EBX].fHandle JECXZ @@2 @@ -5546,7 +5966,12 @@ asm PUSH EAX // prepare Shift - LEA ESI, [EBX].TControl.fOnMouseDown + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EBX].TControl.EV + LEA ESI, [EAX].TEvents.fOnMouseDown + {$ELSE} + LEA ESI, [EBX].TControl.EV.fOnMouseDown + {$ENDIF} CALL dword ptr [EDX*4 + @@jump_table] @@call_evnt: @@ -5554,8 +5979,10 @@ asm PUSH ECX // prepare Button, StopHandling MOV ECX, ESP // ECX = @MouseData + {$IFDEF NIL_EVENTS} CMP word ptr [ESI].TMethod.Code+2, 0 JZ @@after_call + {$ENDIF} MOV EDX, EBX // EDX = Self_ MOV EAX, [ESI].TMethod.Data // EAX = Target_ @@ -5590,16 +6017,16 @@ asm LODSD RET -@@MMove: LEA ESI, [EBX].TControl.fOnMouseMove +@@MMove: ADD ESI, 16 RET @@MDblClk: INC ECX @@RDblClk: INC ECX @@LDblClk: INC ECX - LEA ESI, [EBX].TControl.fOnMouseDblClk + ADD ESI, 24 RET -@@MWheel:LEA ESI, [EBX].TControl.fOnMouseWheel +@@MWheel:ADD ESI, 32 end; {$IFNDEF USE_GRAPHCTLS} @@ -5637,19 +6064,21 @@ asm //cmd //opd @@dyn2: MOV ECX, ESI CALL @@onmess - MOV EBX, [ESI].TControl.fOnDynHandlers + MOV EBX, [ESI].TControl.PP.fOnDynHandlers MOV EAX, ESI CALL @@callonmes @@flicksproc: + (* MOV EAX, ESI MOV EDX, EDI PUSH 0 MOV ECX, ESP - CALL dword ptr [ESI].TControl.fWndProcResizeFlicks + CALL dword ptr [ESI].TControl.PP.fWndProcResizeFlicks TEST AL, AL POP EAX JNZ @@pass2defproc + *) MOVZX EAX, word ptr [EDI].TMsg.message CMP EAX, WM_CLOSE @@ -5669,7 +6098,11 @@ asm //cmd //opd @@chk_WM_DESTROY: CMP AX, WM_DESTROY JNE @@chk_WM_NCDESTROY + {$IFDEF USE_FLAGS} + OR [ESI].TControl.fFlagsG2, (1 shl G2_BeginDestroying) + {$ELSE} MOV [ESI].TControl.fBeginDestroying, AL + {$ENDIF} JMP @@calldef //********************************************************** @@chk_WM_NCDESTROY: @@ -5690,13 +6123,19 @@ asm //cmd //opd // is not a subject to pass it // to fPass2DefProc @@onmess: - MOV EAX, [ECX].TControl.fOnMessage.TMethod.Data - MOV EBX, [ECX].TControl.fOnMessage.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [ECX].TControl.EV + MOV EBX, [EAX].TEvents.fOnMessage.TMethod.Code + MOV EAX, [EAX].TEvents.fOnMessage.TMethod.Data + {$ELSE} + MOV EAX, [ECX].TControl.EV.fOnMessage.TMethod.Data + MOV EBX, [ECX].TControl.EV.fOnMessage.TMethod.Code + {$ENDIF} @@callonmes: + {$IFDEF NIL_EVENTS} TEST EBX, EBX - JNZ @@onmess1 // @@dynmes1 -@@2onmessret: - RET + JZ @@exit // @@dynmes1 + {$ENDIF} @@onmess1: PUSH 0 @@ -5706,7 +6145,7 @@ asm //cmd //opd TEST AL, AL POP EAX - JZ @@2onmessret + JZ @@ret POP EDX // pop retaddr JMP @@pass2defproc @@chk_WM_SIZE: @@ -5718,11 +6157,12 @@ asm //cmd //opd CALL TControl.CallDefWndProc PUSH EAX - MOV ECX, [EDI].TMsg.wParam - MOV [ESI].TControl.fWindowState, CL - {$IFDEF OLD_ALIGN} + {$IFDEF USE_FLAGS} + TEST [ESI].TControl.fFlagsG3, (1 shl G3_IsForm) + {$ELSE} CMP [ESI].TControl.fIsForm, 0 + {$ENDIF} JNZ @@doGlobalAlignSelf MOV EAX, [ESI].TControl.fParent CALL dword ptr [Global_Align] @@ -5819,27 +6259,31 @@ asm //cmd //opd CMP DX, WM_KEYLAST-WM_KEYFIRST JA @@calldef //@@chk_CM_EXECPROC {$IFDEF KEY_PREVIEW} + {$IFDEF USE_FLAGS} + TEST [ESI].TControl.fFlagsG4, 1 shl G4_Pushed + {$ELSE} CMP [ESI].TControl.fKeyPreviewing, 0 - {JE @@nokeypreview1 - CMP AX, WM_KEYDOWN - JE @@in_focus -@@nokeypreview1:} + {$ENDIF} JNE @@in_focus {$ENDIF KEY_PREVIEW} CALL GetFocus - CMP EAX, [ESI].TControl.fFocusHandle - JE @@in_focus + //--- CMP EAX, [ESI].TControl.fFocusHandle + //--- JE @@in_focus CMP EAX, [ESI].TControl.fHandle - JE @@in_focus {$IFDEF USE_GRAPHCTLS} + JE @@in_focus CMP [ESI].fWindowed, 0 - JE @@0pass2defproc {$ENDIF} + JNE @@0pass2defproc @@in_focus: {$IFDEF KEY_PREVIEW} - MOV [ESI].TControl.fKeyPreviewing, 0 + {$IFDEF USE_FLAGS} + AND [ESI].TControl.fFlagsG4, not(1 shl G4_Pushed) + {$ELSE} + MOV [ESI].TControl.fKeyPreviewing, 0 + {$ENDIF} {$ENDIF KEY_PREVIEW} PUSH EAX @@ -5853,7 +6297,7 @@ asm //cmd //opd MOV ECX, ESP MOV EDX, EDI MOV EAX, ESI - CALL [ESI].fWndProcKeybd + CALL [ESI].PP.fWndProcKeybd TEST AL, AL @@to_exit: POP EAX @@ -5880,8 +6324,10 @@ asm //cmd //opd TEST EAX, EAX JZ @@calldef - MOV ECX, [EAX].fGotoControl + MOV ECX, [EAX].PP.fGotoControl + {$IFDEF NIL_EVENTS} JECXZ @@calldef + {$ENDIF} MOV EBX, ECX CMP [EDI].TMsg.message, WM_KEYDOWN @@ -5913,13 +6359,15 @@ asm //cmd //opd @@1pass2defproc: CMP [AppletTerminated], 0 // JNZ @@popeax_exit // uncommented 25-Oct-2003 + {$IFDEF USE_fNCDestroyed} CMP [ESI].fNCDestroyed, 0 // JNZ @@popeax_exit // + {$ENDIF USE_fNCDestroyed} MOV ECX, ESP XCHG EAX, ESI MOV EDX, EDI - CALL dword ptr[EAX].fPass2DefProc + CALL dword ptr[EAX].PP.fPass2DefProc @@popeax_exit: POP EAX @@ -5927,6 +6375,7 @@ asm //cmd //opd POP EDI POP ESI POP EBX +@@ret: end; {$ENDIF no NEW_MODAL} {$ENDIF no USE_GRAPHCTLS} @@ -6059,9 +6508,9 @@ end; procedure TControl.SetIcon( Value: HIcon ); asm //cmd //opd - CMP EDX, [EAX].TControl.fIcon + CMP EDX, [EAX].TControl.DF.fIcon JE @@exit - MOV [EAX].TControl.fIcon, EDX + MOV [EAX].TControl.DF.fIcon, EDX INC EDX JZ @@1 DEC EDX @@ -6115,9 +6564,13 @@ end; procedure TControl.DoAutoSize; asm - MOV ECX, [EAX].fAutoSize + {$IFDEF NIL_EVENTS} + MOV ECX, [EAX].PP.fAutoSize JECXZ @@exit PUSH ECX + {$ELSE not NIL_EVENTS} + PUSH [EAX].PP.fAutoSize + {$ENDIF} @@exit: end; @@ -6144,15 +6597,20 @@ asm CALL SendMessage {$ENDIF} @@0: + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG1, (1 shl G1_IsStaticControl) + JNZ @@1 + {$ELSE} MOVZX ECX, byte ptr [EBX].fIsStaticControl INC ECX LOOP @@1 + {$ENDIF} MOV EAX, EBX CALL Invalidate @@1: XCHG EAX, EBX @@exit: POP EBX - PUSH [EAX].fAutoSize + PUSH [EAX].PP.fAutoSize @@exit_2: end; @@ -6168,31 +6626,53 @@ asm JMP @@checked // Z if not visible @@check_fStyle: - TEST byte ptr [EAX].fStyle+3, 10h // WS_VISIBLE shr 3 + TEST byte ptr [EAX].fStyle.f3_Style, F3_Visible // WS_VISIBLE shr 3 @@checked: + {$IFDEF USE_FLAGS} + SETNZ AL + {$ELSE} SETNZ DL MOV [EAX].fVisible, DL XCHG EAX, EDX + {$ENDIF} end; function TControl.Get_Visible: Boolean; -asm // // - MOV ECX, [EAX].fHandle - JECXZ @@ret_fVisible - CMP [EAX].fIsControl, 0 - JNZ @@ret_fVisible - PUSH EAX - PUSH ECX - CALL IsWindowVisible - XCHG EDX, EAX - POP EAX - MOV [EAX].fVisible, DL +asm // // + {$IFDEF USE_FLAGS} + CALL GetVisible + {$ELSE} + MOV ECX, [EAX].fHandle + JECXZ @@ret_fVisible + {$IFDEF USE_FLAGS} + TEST [EAX].fFlagsG3, 1 shl G3_IsControl + {$ELSE} + CMP [EAX].fIsControl, 0 + {$ENDIF} + JNZ @@ret_fVisible + PUSH EAX + PUSH ECX + CALL IsWindowVisible + XCHG EDX, EAX + POP EAX + {$IFDEF USE_FLAGS} + SHL DL, F3_Visible + AND [EAX].TControl.fStyle.f3_Style, not(1 shl F3_Visible) + OR [EAX].TControl.fStyle.f3_Style, DL + {$ELSE} + MOV [EAX].fVisible, DL + {$ENDIF} @@ret_fVisible: - MOVZX EAX, [EAX].fVisible + {$IFDEF USE_FLAGS} + TEST [EAX].fStyle.f3_Style, (1 shl F3_Visible) + SETNZ AL + {$ELSE} + MOVZX EAX, [EAX].fVisible + {$ENDIF} + {$ENDIF USE_FLAGS} end; procedure TControl.Set_Visible( Value: Boolean ); -const wsVisible = $10; asm {$IFDEF OLD_ALIGN} PUSH EBX @@ -6207,16 +6687,27 @@ asm MOV AL, byte ptr [ESI].fStyle + 3 TEST EBX, EBX JZ @@reset_WS_VISIBLE + {$IFDEF USE_FLAGS} + OR AL, 1 shl F3_Visible + {$ELSE} OR AL, wsVisible + {$ENDIF} PUSH SW_SHOW JMP @@store_Visible @@reset_WS_VISIBLE: + {$IFDEF USE_FLAGS} + AND AL, not(1 shl F3_Visible) + {$ELSE} AND AL, not wsVisible + {$ENDIF} PUSH SW_HIDE @@store_Visible: MOV byte ptr [ESI].fStyle + 3, AL + {$IFDEF USE_FLAGS} + {$ELSE} MOV [ESI].fVisible, BL + {$ENDIF} MOV ECX, [ESI].fHandle JECXZ @@after_showwindow @@ -6241,17 +6732,24 @@ asm JECXZ @@exit TEST BL, BL JNZ @@exit + {$IFDEF USE_FLAGS} + AND [ESI], not(1 shl G4_CreateHidden) + {$ELSE} MOV [ESI].fCreateHidden, BL { +++ } + {$ENDIF} @@exit: POP ESI POP EBX {$ELSE NEW_ALIGN} - AND byte ptr [EAX].fStyle + 3, not wsVisible + AND byte ptr [EAX].fStyle.f3_Style, not(1 shl F3_Visible) TEST DL,DL JZ @@0 - OR byte ptr [EAX].fStyle + 3, wsVisible + OR byte ptr [EAX].fStyle.f3_Style, (1 shl F3_Visible) @@0: + {$IFDEF USE_FLAGS} + {$ELSE} MOV [EAX].fVisible, DL + {$ENDIF USE_FLAGS} MOV ECX, [EAX].fHandle JECXZ @@exit PUSH EAX @@ -6264,7 +6762,11 @@ asm @@exit: RET @@1: - MOV [EAX].fCreateHidden, DL + {$IFDEF USE_FLAGS} + AND [EAX].fFlagsG4, not(1 shl G4_CreateHidden) + {$ELSE} + MOV [EAX].fCreateHidden, DL // = 0 + {$ENDIF} PUSH SW_HIDE PUSH ECX CALL ShowWindow @@ -6273,6 +6775,16 @@ asm {$ENDIF} end; +procedure TControl.SetVisible( Value: Boolean ); +asm + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG4, 1 shl G4_CreateVisible + {$ELSE} + MOV [EAX].TControl.fCreateVisible, 1 + {$ENDIF} + CALL TControl.Set_Visible +end; + function TControl.GetBoundsRect: TRect; asm PUSH ESI @@ -6297,8 +6809,12 @@ asm PUSH ECX CALL GetWindowRect - MOV AL, [ESI].fIsMDIChild - OR AL, [ESI].fIsControl + {$IFDEF USE_FLAGS} + TEST [ESI].fFlagsG3, (1 shl G3_IsControl) or (1 shl G3_IsMDIChild) + {$ELSE} + MOV AL, [ESI].fIsControl + OR AL, [ESI].fIsMDIChild + {$ENDIF} JZ @@storeBounds @@chk_Parent: @@ -6374,14 +6890,21 @@ asm SUB EAX, EDX // EAX = width CMP EDX, [ESI].TRect.Left + {$IFDEF USE_FLAGS} + {$ELSE} MOV DL, 0 - JE @@1 - INC EDX + {$ENDIF} + JNE @@11 @@1: CMP ECX, [ESI].TRect.Top JE @@2 +@@11: + {$IFDEF USE_FLAGS} + OR [EDI].fFlagsG2, (1 shl G2_ChangedPos) + {$ELSE} OR DL, 2 -@@2: OR [EDI].fChangedPosSz, DL - + OR [EDI].fChangedPosSz, DL + {$ENDIF} +@@2: PUSH EAX // W saved MOV EAX, [EDI].fBoundsRect.Bottom @@ -6390,8 +6913,13 @@ asm PUSH EDI // @Self saved {$IFDEF USE_GRAPHCTLS} + {$IFDEF USE_FLAGS} + TEST [EDI].fFlagsG6, 1 shl G6_GraphicCtl + JZ @@invalid1 + {$ELSE} CMP [EDI].fWindowed, 0 JNZ @@invalid1 + {$ENDIF} MOV EAX, EDI CALL TControl.InvalidateNonWindowed @@invalid1: @@ -6438,7 +6966,11 @@ asm POP EDX // H restored POP EAX // W restored + {$IFDEF USE_FLAGS} + TEST [EDI].fFlagsG1, (1 shl G1_SizeRedraw) + {$ELSE} CMP [EDI].fSizeRedraw, 0 + {$ENDIF USE_FLAGS} JE @@exit @@invalid2: XCHG EAX, EDI @@ -6452,17 +6984,22 @@ end; procedure TControl.SetWindowState( Value: TWindowState ); asm //cmd //opd - CMP [EAX].TControl.fWindowState, DL + PUSH EAX + PUSH EDX + CALL TControl.GetWindowState + POP EDX + CMP AL, DL + POP EAX JE @@exit - MOV [EAX].TControl.fWindowState, DL + MOV [EAX].TControl.DF.fWindowState, DL + MOV ECX, [EAX].TControl.fHandle + JECXZ @@exit XCHG EAX, EDX CBW CWDE MOV AL, byte ptr [WindowStateShowCommands+EAX] PUSH EAX - XCHG EAX, EDX - CALL TControl.GetWindowHandle - PUSH EAX + PUSH ECX CALL ShowWindow @@exit: end; @@ -6557,13 +7094,17 @@ asm @@exit: POP EDX POP EDX // EDX = @Result LEA ESI, [ESI].fClientTop - LODSD + LODSB + MOVSX EAX, AL ADD [EDX].TRect.Top, EAX - LODSD + LODSB + MOVSX EAX, AL SUB [EDX].TRect.Bottom, EAX - LODSD + LODSB + MOVSX EAX, AL ADD [EDX].TRect.Left, EAX - LODSD + LODSB + MOVSX EAX, AL SUB [EDX].TRect.Right, EAX POP ESI end; @@ -6571,37 +7112,36 @@ end; procedure TControl.Invalidate; asm {$IFDEF USE_GRAPHCTLS} - PUSH dword ptr [EAX].TControl.fDoInvalidate + PUSH dword ptr [EAX].TControl.PP.fDoInvalidate {$ELSE} MOV ECX, [EAX].fHandle JECXZ @@exit PUSH $FF PUSH 0 PUSH ECX - CALL InvalidateRect + CALL Windows.InvalidateRect @@exit: {$ENDIF} end; {$IFDEF USE_GRAPHCTLS} -procedure TControl.InvalidateWindowed; +procedure InvalidateWindowed( Sender: PObj ); asm - MOV ECX, [EAX].fHandle + MOV ECX, [EAX].TControl.fHandle JECXZ @@exit PUSH $FF PUSH 0 PUSH ECX - CALL InvalidateRect + CALL Windows.InvalidateRect @@exit: end; {$ENDIF USE_GRAPHCTLS} -//{$IFDEF ASM_UNICODE} function TControl.GetIcon: HIcon; asm PUSH EBX XCHG EBX, EAX - MOV EAX, [EBX].fIcon + MOV EAX, [EBX].DF.fIcon INC EAX JZ @@exit DEC EAX @@ -6649,7 +7189,7 @@ asm PUSH [hInstance] CALL LoadIcon @@store_fIcon: - MOV [EBX].fIcon, EAX + MOV [EBX].DF.fIcon, EAX @@exit: POP EBX end; @@ -6683,7 +7223,7 @@ asm //cmd //opd PUSH EBX PUSH ESI XCHG ESI, EAX - MOVZX EBX, [ESI].TControl.fWindowState + MOVZX EBX, [ESI].TControl.DF.fWindowState MOV ECX, [ESI].TControl.fHandle JECXZ @@ret_EBX MOV BL, 2 @@ -6704,6 +7244,31 @@ asm //cmd //opd POP EBX end; +function TControl.DoSetFocus: Boolean; +asm + PUSH ESI + MOV ESI, EAX + + CALL GetEnabled + {$IFDEF USE_FLAGS} + MOV DL, byte ptr [ESI].TControl.fStyle.f2_Style + // F2_Tabstop = 0 ! + {$ELSE} + MOV DL, byte ptr [ESI+2].TControl.fStyle + OR DL, [ESI].TControl.fTabstop + {$ENDIF USE_FLAGS} + AND AL, DL + JZ @@exit + + INC [ESI].TControl.fClickDisabled + PUSH [ESI].TControl.fHandle + CALL SetFocus + DEC [ESI].TControl.fClickDisabled + MOV AL, 1 +@@exit: + POP ESI +end; + function TControl.GetEnabled: Boolean; asm MOV ECX, [EAX].fHandle @@ -6724,7 +7289,11 @@ asm XCHG ECX, EAX MOV EAX, [Applet] TEST EAX, EAX JNZ @@0 + {$IFDEF USE_FLAGS} + TEST [ECX].fFlagsG3, 1 shl G3_IsControl + {$ELSE} CMP [ECX].fIsControl, AL + {$ENDIF} JMP @@3 @@0: CMP [appbuttonUsed], DL JZ @@2 @@ -6767,8 +7336,10 @@ asm {$ENDIF} {$IFNDEF SMALLEST_CODE} - MOV ECX, [EAX].fNotifyChild + MOV ECX, [EAX].PP.fNotifyChild + {$IFDEF NIL_EVENTS} JECXZ @@1 + {$ENDIF} XOR EDX, EDX CALL ECX {$ENDIF} @@ -6799,14 +7370,18 @@ asm {$ENDIF} {$IFNDEF SMALLEST_CODE} - MOV ECX, [EDI].fNotifyChild + MOV ECX, [EDI].PP.fNotifyChild + {$IFDEF NIL_EVENTS} JECXZ @@3 + {$ENDIF} MOV EAX, EDI MOV EDX, EBX CALL ECX @@3: - MOV ECX, [EBX].fNotifyChild + MOV ECX, [EBX].PP.fNotifyChild + {$IFDEF NIL_EVENTS} JECXZ @@4 + {$ENDIF} MOV EAX, EDI MOV EDX, EBX CALL ECX @@ -7046,7 +7621,12 @@ asm JECXZ @@1 + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EBX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aSetBkColor + {$ELSE} MOVZX ECX, [EBX].fCommandActions.aSetBkColor + {$ENDIF} JECXZ @@1 PUSH EDX @@ -7164,8 +7744,10 @@ asm JMP @@fin @@tran_disp: - MOV ECX, [EBX].fExMsgProc + MOV ECX, [EBX].PP.fExMsgProc + {$IFDEF NIL_EVENTS} JECXZ @@do_tran_disp + {$ENDIF} MOV EAX, EBX MOV EDX, ESP CALL ECX @@ -7197,6 +7779,90 @@ asm JZ @@loo end; +function WndProcForm(Self_: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; +const szPaintStruct = sizeof(TPaintStruct); +asm //cmd //opd + {$IFDEF ENDSESSION_HALT} + CMP word ptr [EDX].TMsg.message, WM_ENDSESSION + JNE @@chk_WM_SETFOCUS + + CMP [EDX].TMsg.wParam, 0 + JZ @@ret_false + + CALL TObj.RefDec + XOR EAX, EAX + MOV [AppletRunning], AL + XCHG EAX, [Applet] + INC [AppletTerminated] + + CALL TObj.RefDec + CALL System.@Halt0 + {$ENDIF ENDSESSION_HALT} + +@@chk_WM_SETFOCUS: + CMP word ptr [EDX].TMsg.message, WM_SETFOCUS + JNE @@ret_false + + PUSH EBX + PUSH ESI + XOR EBX, EBX + INC EBX + XCHG ESI, EAX + {$IFDEF NEW_MODAL} + MOV ECX, [ESI].TControl.DF.fModalForm + JECXZ @@no_fix_modal_setfocus + PUSH [ECX].TControl.fHandle + CALL SetFocus +@@no_fix_modal_setfocus: + MOV ECX, [ESI].TControl.DF.FCurrentControl + JECXZ @@setFocuswhenCreateWindow + {$IFDEF USE_FLAGS} + TEST [ECX].TControl.fFlagsG3, (1 shl G3_IsForm) + SETNZ DL + TEST [ESI].TControl.fFlagsG3, (1 shl G3_IsApplet) + SETNZ DH + XOR DL, DH + JNZ @@1 + {$ELSE} + MOV DL, [ECX].TControl.fIsForm + XOR DL, [ESI].TControl.FIsApplet + JNZ @@1 + {$ENDIF} + {$ELSE not NEW_MODAL} + MOV ECX, [ESI].TControl.DF.fCurrentControl + JECXZ @@0 + {$ENDIF} +@@setFocuswhenCreateWindow: + JECXZ @@1 //+++++++++++++++ + //INC EBX + XCHG EAX, ECX + + // or CreateForm? + PUSH EAX + CALL CallTControlCreateWindow + TEST AL, AL + POP EAX + JZ @@1 + + PUSH [EAX].TControl.fHandle + CALL SetFocus + INC EBX +@@0: DEC EBX +@@1: MOV ECX, [Applet] + JECXZ @@ret_EBX + CMP ECX, ESI + JE @@ret_EBX + MOV [ECX].TControl.DF.FCurrentControl, ESI +@@ret_EBX: + XCHG EAX, EBX + POP ESI + POP EBX + RET + +@@ret_false: + XOR EAX, EAX +end; + function GetPrevCtrlBoundsRect( P: PControl; var R: TRect ): Boolean; asm MOV EDX, EBX @@ -7236,7 +7902,8 @@ asm POP EDX // EDX = Bottom MOV EAX, [EBX].fParent - ADD EDX, [EAX].fMargin + MOVSX ECX, [EAX].fMargin + ADD EDX, ECX MOV EAX, EBX CALL TControl.SetTop @@ -7257,7 +7924,8 @@ asm POP EDX // EDX = Bottom MOV EAX, [EBX].fParent - ADD EDX, [EAX].fMargin + MOVSX ECX, [EAX].fMargin + ADD EDX, ECX MOV EAX, EBX CALL TControl.SetTop @@ -7279,7 +7947,8 @@ asm POP EDX // EDX = Right MOV EAX, [EBX].fParent - ADD EDX, [EAX].fMargin + MOVSX ECX, [EAX].fMargin + ADD EDX, ECX POP ECX MOV EAX, EBX @@ -7342,22 +8011,313 @@ asm POP EAX end; +function WndProcCtrl( Self_: PControl; var Msg: TMsg; var Rslt: Integer): Boolean; +asm //cmd //opd + PUSH EBX + XCHG EBX, EAX + PUSH ESI + PUSH EDI + MOV EDI, EDX + MOV EDX, [EDI].TMsg.message + + SUB DX, CN_CTLCOLORMSGBOX + CMP DX, CN_CTLCOLORSTATIC-CN_CTLCOLORMSGBOX + JA @@chk_CM_COMMAND +@@2: + PUSH ECX + MOV EAX, [EBX].TControl.fTextColor + CALL Color2RGB + XCHG ESI, EAX + PUSH ESI + PUSH [EDI].TMsg.wParam + CALL SetTextColor + {$IFDEF USE_FLAGS} + TEST [EBX].TControl.fFlagsG2, (1 shl G2_Transparent) + {$ELSE} + CMP [EBX].TControl.fTransparent, 0 + {$ENDIF} + JZ @@opaque + + PUSH Windows.TRANSPARENT + PUSH [EDI].TMsg.wParam + CALL SetBkMode + PUSH NULL_BRUSH + CALL GetStockObject + JMP @@ret_rslt + +@@opaque: + MOV EAX, [EBX].TControl.fColor + CALL Color2RGB + XCHG ESI, EAX + PUSH OPAQUE + PUSH [EDI].TMsg.wParam + CALL SetBkMode + PUSH ESI + PUSH [EDI].TMsg.wParam + CALL SetBkColor + + MOV EAX, EBX + CALL Global_GetCtlBrushHandle +@@ret_rslt: + XCHG ECX, EAX +@@tmpbrushready: + POP EAX + MOV [EAX], ECX +@@ret_true: + MOV AL, 1 + + JMP @@ret_EAX + +@@chk_CM_COMMAND: + CMP word ptr [EDI].TMsg.message, CM_COMMAND + JNE @@chk_WM_SETFOCUS + + PUSH ECX + + MOVZX ECX, word ptr [EDI].TMsg.wParam+2 + {$IFDEF COMMANDACTIONS_OBJ} + MOV ESI, [EBX].TControl.fCommandActions + CMP CX, [ESI].TCommandActionsObj.aClick + {$ELSE} + CMP CX, [EBX].TControl.fCommandActions.aClick + {$ENDIF} + JNE @@chk_aEnter + + CMP [EBX].TControl.fClickDisabled, 0 + JG @@calldef + MOV EAX, EBX + MOV DL, 1 + CALL TControl.SetFocused + MOV EAX, EBX + CALL TControl.DoClick + JMP @@calldef + +@@chk_aEnter: + {$IFDEF COMMANDACTIONS_OBJ} + MOV EAX, [EBX].TControl.fCommandActions + CMP CX, [EAX].TCommandActionsObj.aEnter + {$ELSE} + CMP CX, [EBX].TControl.fCommandActions.aEnter + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EBX].TControl.EV + LEA EAX, [EAX].TEvents.fOnEnter + {$ELSE} + LEA EAX, [EBX].TControl.EV.fOnEnter + {$ENDIF} + JE @@goEvent + //LEA EAX, [EBX].TControl.EV.fOnLeave + ADD EAX, 8 + {$IFDEF COMMANDACTIONS_OBJ} + CMP CX, [ESI].TCommandActionsObj.aLeave + {$ELSE} + CMP CX, [EBX].TControl.fCommandActions.aLeave + {$ENDIF} + JE @@goEvent + //LEA EAX, [EBX].TControl.EV.fOnChange + SUB EAX, 16 + {$IFDEF COMMANDACTIONS_OBJ} + CMP CX, [ESI].TCommandActionsObj.aChange + {$ELSE} + CMP CX, [EBX].TControl.fCommandActions.aChange + {$ENDIF} + JNE @@chk_aSelChange +@@goEvent: + MOV ECX, [EAX].TMethod.Code + {$IFDEF NIL_EVENTS} + JECXZ @@2calldef + {$ENDIF} + MOV EAX, [EAX].TMethod.Data + MOV EDX, EBX + CALL ECX +@@2calldef: + JMP @@calldef + +@@chk_aSelChange: + {$IFDEF COMMANDACTIONS_OBJ} + CMP CX, [ESI].TCommandActionsObj.aSelChange + {$ELSE} + CMP CX, [EBX].TControl.fCommandActions.aSelChange + {$ENDIF} + JNE @@chk_WM_SETFOCUS_1 + MOV EAX, EBX + CALL TControl.DoSelChange + +@@calldef: + XCHG EAX, EBX + MOV EDX, EDI + CALL TControl.CallDefWndProc + JMP @@ret_rslt + +@@chk_WM_SETFOCUS_1: + POP ECX +@@chk_WM_SETFOCUS: + XOR EAX, EAX + CMP word ptr [EDI].TMsg.message, WM_SETFOCUS + JNE @@chk_WM_KEYDOWN + + MOV [ECX], EAX + MOV EAX, EBX + CALL TControl.ParentForm + TEST EAX, EAX + JZ @@ret_true + + PUSH EAX + MOV ECX, [EAX].TControl.DF.FCurrentControl + JECXZ @@a1 + CMP ECX, EBX + JZ @@a1 + XCHG EAX, ECX + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TControl.EV + MOV ECX, [EAX].TEvents.fLeave.TMethod.Code + {$ELSE} + MOV ECX, [EAX].TControl.EV.fLeave.TMethod.Code + {$ENDIF} + {$IFDEF NIL_EVENTS} + JECXZ @@a1 + {$ENDIF} + XCHG EDX, EAX + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EDX].TEvents.fLeave.TMethod.Data + {$ELSE} + MOV EAX, [EDX].TControl.EV.fLeave.TMethod.Data + {$ENDIF} + CALL ECX +@@a1: POP EAX + + MOV [EAX].TControl.DF.FCurrentControl, EBX + XOR EAX, EAX + + PUSH EDX +@@2ret_EAX: + POP EDX + +@@chk_WM_KEYDOWN: + {$IFDEF KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS} + CMP word ptr [EDI].TMsg.message, WM_KEYDOWN + {$IFDEF KEY_PREVIEW} + JNE @@chk_other_KEYMSGS + {$ELSE} + JNE @@ret0 + {$ENDIF} + + {$IFDEF KEY_PREVIEW} + MOV EAX, EBX + CALL TControl.ParentForm + CMP EAX, EBX + JE @@kp_end + + {$IFDEF USE_FLAGS} + TEST [EAX].TControl.fFlagsG6, 1 shl G6_KeyPreview + {$ELSE} + CMP [EAX].TControl.fKeyPreview, 0 + {$ENDIF} + JZ @@kp_end + + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG4, 1 shl G4_Pushed + {$ELSE} + MOV [EAX].TControl.fKeyPreviewing, 1 + {$ENDIF} + INC [EAX].TControl.DF.fKeyPreviewCount + PUSH EAX + + PUSH [EDI].TMsg.lParam + PUSH [EDI].TMsg.wParam + PUSH WM_KEYDOWN + PUSH EAX + CALL TControl.Perform + POP EAX + DEC [EAX].TControl.DF.fKeyPreviewCount +@@kp_end: + {$ENDIF} + + {$IFDEF ESC_CLOSE_DIALOGS} + MOV EAX, EBX + CALL TControl.ParentForm + TEST [EAX].TControl.fExStyle, WS_EX_DLGMODALFRAME + JZ @@ecd_end + CMP [EDI].TMsg.wParam, 27 + JNE @@ecd_end + PUSH 0 + PUSH 0 + PUSH WM_CLOSE + PUSH EAX + CALL TControl.Perform +@@ecd_end: + {$ENDIF} + +@@ret0: + XOR EAX, EAX + {$IFDEF KEY_PREVIEW} + JMP @@ret_EAX +@@chk_other_KEYMSGS: + MOVZX EAX, word ptr [EDI].TMsg.message + SUB AX, WM_KEYDOWN + JB @@ret0 + CMP AX, 6 + JA @@ret0 + // all WM_KEYUP=$101, WM_CHAR=$102, WM_DEADCHAR=$103, WM_SYSKEYDOWN=$104, + // WM_SYSKEYUP=$105, WM_SYSCHAR=$106, WM_SYSDEADCHAR=$107 + MOV EAX, EBX + CALL TControl.ParentForm + CMP EAX, EBX + JE @@ret0 + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG4, 1 shl G4_Pushed + {$ELSE} + MOV [EAX].TControl.fKeyPreviewing, 1 + {$ENDIF} + INC [EAX].TControl.DF.fKeyPreviewCount + PUSH EAX + PUSH [EDI].TMsg.lParam + PUSH [EDI].TMsg.wParam + PUSH [EDI].TMsg.message + PUSH EAX + CALL TControl.Perform + POP EAX + DEC [EAX].TControl.DF.fKeyPreviewCount + XOR EAX, EAX + {$ENDIF KEY_PREVIEW} + {$ENDIF KEY_PREVIEW_OR_ESC_CLOSE_DIALOGS} + +@@ret_EAX: + POP EDI + POP ESI + POP EBX +end; + procedure TControl.DoClick; asm PUSH EAX - CALL [EAX].fControlClick + CALL [EAX].PP.fControlClick POP EDX - - MOV ECX, [EDX].fOnClick.TMethod.Code + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EDX].TControl.EV + MOV ECX, [EAX].TEvents.fOnClick.TMethod.Code + {$ELSE} + MOV ECX, [EDX].EV.fOnClick.TMethod.Code + {$ENDIF} + {$IFDEF NIL_EVENTS} JECXZ @@exit - MOV EAX, [EDX].fOnClick.TMethod.Data + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TEvents.fOnClick.TMethod.Data + {$ELSE} + MOV EAX, [EDX].EV.fOnClick.TMethod.Data + {$ENDIF} CALL ECX @@exit: end; function TControl.ParentForm: PControl; asm -@@1: CMP [EAX].fIsControl, 0 +@@1: {$IFDEF USE_FLAGS} + TEST [EAX].fFlagsG3, 1 shl G3_IsControl + {$ELSE} + CMP [EAX].fIsControl, 0 + {$ENDIF} JZ @@exit MOV EAX, [EAX].fParent TEST EAX, EAX @@ -7438,7 +8398,7 @@ asm MOV ECX, [EDX].TGraphicTool.fData.Color MOV [EAX].fTextColor, ECX PUSH EAX - CALL ApplyFont2Wnd + CALL [ApplyFont2Wnd_Proc] POP EAX CALL Invalidate end; @@ -7510,10 +8470,16 @@ asm JZ @@exit MOV EDX, [EAX].fBoundsRect.Bottom - ADD EDX, [EBX].fMargin + MOVSX ECX, [EBX].fMargin + ADD EDX, ECX + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG2, (1 shl G2_ChangedSize) + JZ @@1 + {$ELSE} TEST [EBX].fChangedPosSz, 20h JZ @@1 + {$ENDIF} PUSH EDX MOV EAX, EBX @@ -7525,7 +8491,11 @@ asm @@1: MOV EAX, EBX CALL TControl.SetClientHeight + {$IFDEF USE_FLAGS} + OR [EBX].fFlagsG2, (1 shl G2_ChangedSize) + {$ELSE} OR [EBX].fChangedPosSz, 20h + {$ENDIF} @@exit: POP EBX POP EAX @@ -7540,9 +8510,14 @@ asm JZ @@exit MOV EDX, [EAX].fBoundsRect.Right - ADD EDX, [EBX].fMargin + MOVSX ECX, [EBX].fMargin + ADD EDX, ECX + {$IFDEF USE_FLAGS} + TEST [EBX].fFlagsG2, (1 shl G2_ChangedSize) + {$ELSE} TEST [EBX].fChangedPosSz, 10h + {$ENDIF} JZ @@1 PUSH EDX @@ -7555,7 +8530,11 @@ asm @@1: MOV EAX, EBX CALL TControl.SetClientWidth + {$IFDEF USE_FLAGS} + OR [EBX].fFlagsG2, (1 shl G2_ChangedSize) + {$ELSE} OR [EBX].fChangedPosSz, 10h + {$ENDIF} @@exit: POP EBX POP EAX @@ -7632,7 +8611,11 @@ asm XCHG ESI, EAX MOV ECX, [ESI].fParent JECXZ @@1 + {$IFDEF USE_FLAGS} + TEST [ESI].fFlagsG3, 1 shl G3_IsControl + {$ELSE} CMP [ESI].fIsControl, 0 + {$ENDIF} JNZ @@2 @@1: @@ -7741,7 +8724,11 @@ asm JMP @@set_style @@1: + {$IFDEF USE_FLAGS} + TEST [EAX].fFlagsG3, 1 shl G3_IsControl + {$ELSE} CMP [EAX].fIsControl, 0 + {$ENDIF} JNZ @@2 // if fIsControl -> @@2 AND EDX, not (WS_CAPTION or WS_SYSMENU) @@ -7770,8 +8757,13 @@ end; function TControl.GetCanResize: Boolean; asm + {$IFDEF USE_FLAGS} + TEST [EAX].fFlagsG1, (1 shl G1_PreventResize) + SETZ AL + {$ELSE} MOV AL, [EAX].fPreventResize {$IFDEF PARANOIA} DB $34,$01 {$ELSE} XOR AL, 1 {$ENDIF} + {$ENDIF USE_FLAGS} end; procedure TControl.SetCanResize( const Value: Boolean ); @@ -7783,7 +8775,14 @@ asm CMP AL, DL JZ @@exit // Value = CanResize + {$IFDEF USE_FLAGS} + // AL:bit0 = can resize + SHL AL, G1_PreventResize + AND [EBX].fFlagsG1, not (1 shl G1_PreventResize) + OR [EBX].fFlagsG1, AL + {$ELSE} MOV [EBX].fPreventResize, AL + {$ENDIF USE_FLAGS} {$IFDEF CANRESIZE_THICKFRAME} TEST DL, DL @@ -7801,6 +8800,7 @@ asm CALL SetStyle {$ENDIF CANRESIZE_THICKFRAME} + {$IFDEF FIX_WIDTH_HEIGHT} MOV EAX, EBX CALL GetWindowHandle @@ -7811,6 +8811,7 @@ asm MOV EAX, EBX CALL GetHeight MOV [EBX].FFixHeight, EAX + {$ENDIF FIX_WIDTH_HEIGHT} XCHG EAX, EBX MOV EDX, offset[WndProcCanResize] @@ -7900,9 +8901,14 @@ end; function TControl.GetChecked: Boolean; asm - TEST [EAX].fBitBtnOptions, 8 //1 shl Ord(bboFixed) + TEST [EAX].DF.fBitBtnOptions, 8 //1 shl Ord(bboFixed) JZ @@1 + {$IFDEF USE_FLAGS} + TEST [EAX].fFlagsG4, 1 shl G4_Checked + SETNZ AL + {$ELSE} MOV AL, [EAX].fChecked + {$ENDIF} RET @@1: PUSH 0 @@ -7915,9 +8921,15 @@ end; procedure TControl.Set_Checked(const Value: Boolean); asm - TEST [EAX].fBitBtnOptions, 8 //1 shl Ord(bboFixed) + TEST [EAX].DF.fBitBtnOptions, 8 //1 shl Ord(bboFixed) JZ @@1 + {$IFDEF USE_FLAGS} + SHL DL, G4_Checked + AND [EAX].fFlagsG4, not(1 shl G4_Checked) + OR [EAX].fFlagsG4, DL + {$ELSE} MOV [EAX].fChecked, DL + {$ENDIF} JMP Invalidate @@1: PUSH 0 @@ -7928,25 +8940,16 @@ asm Call Perform end; -function TControl.SetRadioCheckedOld: PControl; -asm - PUSH EAX - MOV ECX, [EAX].fParent - JECXZ @@exit - - PUSH [EAX].fMenu - PUSH [ECX].fRadioLast - PUSH [ECX].fRadio1st - MOV EAX, ECX - CALL GetWindowHandle - PUSH EAX - CALL CheckRadioButton -@@exit: - POP EAX -end; - function TControl.SetRadioChecked: PControl; asm + {$IFDEF USE_FLAGS} + PUSH DWORD PTR[EAX].fStyle + PUSH EAX + AND [EAX].fStyle.f2_Style, not(1 shl F2_Tabstop) + CALL DoClick + POP EAX + POP DWORD PTR[EAX].fStyle + {$ELSE} PUSH EAX PUSH DWORD PTR[EAX].fTabStop MOV [EAX].fTabStop, 0 @@ -7955,11 +8958,17 @@ asm POP EDX POP EAX MOV [EAX].fTabStop, DL + {$ENDIF USE_FLAGS} end; function TControl.GetSelStart: Integer; asm + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aGetSelRange + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aGetSelRange + {$ENDIF} JECXZ @@exit XOR EDX, EDX PUSH EDX // space for Result @@ -7977,7 +8986,12 @@ end; function TControl.GetSelLength: Integer; asm XOR EDX, EDX + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, word ptr[ECX].TCommandActionsObj.aGetSelCount + {$ELSE} MOVZX ECX, word ptr[EAX].fCommandActions.aGetSelCount + {$ENDIF} JECXZ @@ret_ecx CMP CX, EM_GETSEL @@ -8018,13 +9032,23 @@ asm POP EDX ADD ECX, EAX PUSH ECX + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EDX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aSetSelRange + {$ELSE} MOVZX ECX, [EDX].fCommandActions.aSetSelRange + {$ENDIF} JECXZ @@check_ex PUSH EAX JMP @@perform @@check_ex: + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EDX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aExSetSelRange + {$ELSE} MOVZX ECX, [EDX].fCommandActions.aExSetSelRange + {$ENDIF} JECXZ @@exit PUSH EAX PUSH ESP @@ -8040,7 +9064,12 @@ end; function TControl.GetItemsCount: Integer; asm PUSH 0 + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aGetCount + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aGetCount + {$ENDIF} JECXZ @@ret_0 PUSH 0 PUSH ECX @@ -8071,19 +9100,34 @@ end; function TControl.Item2Pos(ItemIdx: Integer): DWORD; asm - MOVZX ECX, [EAX].fCommandActions.aItem2Pos + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.bItem2Pos + {$ELSE} + MOVZX ECX, BYTE PTR [EAX].fCommandActions.bItem2Pos + {$ENDIF} JMP HelpConvertItem2Pos end; function TControl.Pos2Item(Pos: Integer): DWORD; asm - MOVZX ECX, [EAX].fCommandActions.aPos2Item + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.bPos2Item + {$ELSE} + MOVZX ECX, BYTE PTR [EAX].fCommandActions.bPos2Item + {$ENDIF} JMP HelpConvertItem2Pos end; procedure TControl.Delete(Idx: Integer); asm + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aDeleteItem + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aDeleteItem + {$ENDIF} JECXZ @@exit PUSH 0 @@ -8096,7 +9140,12 @@ end; function TControl.GetItemSelected(ItemIdx: Integer): Boolean; asm + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aGetSelected + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aGetSelected + {$ENDIF} JECXZ @@check_range PUSH 1 @@ -8138,7 +9187,12 @@ procedure TControl.SetItemSelected(ItemIdx: Integer; const Value: Boolean); asm PUSH EDX PUSH ECX + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aSetSelected + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aSetSelected + {$ENDIF} JECXZ @@chk_aSetCurrent @@0: @@ -8149,7 +9203,12 @@ asm @@chk_aSetCurrent: POP ECX + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aSetCurrent + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aSetCurrent + {$ENDIF} JECXZ @@chk_aSetSelRange POP EDX @@ -8157,7 +9216,12 @@ asm JMP @@3 @@chk_aSetSelRange: + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aSetSelRange + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aSetSelRange + {$ENDIF} JECXZ @@chk_aExSetSelRange @@3: PUSH EDX @@ -8168,7 +9232,12 @@ asm JMP @@exit @@chk_aExSetSelRange: + {$IFDEF COMMANDACTIONS_OBJ} + MOV EAX, [EAX].fCommandActions + MOVZX ECX, [EAX].TCommandActionsObj.aExSetSelRange + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aExSetSelRange + {$ENDIF} JECXZ @@else PUSH EDX @@ -8185,13 +9254,13 @@ end; procedure TControl.SetCtl3D(const Value: Boolean); asm - MOV [EAX].fCtl3Dchild, DL - //CMP [EAX].fCtl3D, DL - //JE @@exit - MOV [EAX].fCtl3D, DL + AND [EAX].fCtl3D_child, not 1 + OR [EAX].fCtl3D_child, DL + PUSHAD CALL UpdateWndStyles POPAD + MOV ECX, [EAX].fExStyle DEC DL MOV EDX, [EAX].fStyle @@ -8293,7 +9362,7 @@ asm CALL ParentForm TEST EAX, EAX JZ @@exit - MOV [EAX].fGotoControl, offset[Tabulate2Control] + MOV [EAX].PP.fGotoControl, offset[Tabulate2Control] @@exit: POP EAX end; @@ -8303,7 +9372,7 @@ asm CALL ParentForm TEST EAX, EAX JZ @@exit - MOV [EAX].fGotoControl, offset[Tabulate2ControlEx] + MOV [EAX].PP.fGotoControl, offset[Tabulate2ControlEx] @@exit: POP EAX end; @@ -8312,7 +9381,12 @@ asm PUSH EBX XCHG EBX, EAX MOV EAX, [EBX].fCurIndex + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EBX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aGetCurrent + {$ELSE} MOVZX ECX, [EBX].fCommandActions.aGetCurrent + {$ENDIF} JECXZ @@exit XOR EAX, EAX CDQ @@ -8369,7 +9443,12 @@ end;} procedure TControl.SetCurIndex(const Value: Integer); // fix av asm + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aSetCurrent + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aSetCurrent + {$ENDIF} JECXZ @@set_item_sel PUSH ECX //+aSetCurrent PUSH EAX //+self @@ -8404,7 +9483,12 @@ asm PUSH EAX CALL UpdateWndStyles MOV ECX, [EAX].fStyle + {$IFDEF COMMANDACTIONS_OBJ} + MOV EDX, [EAX].fCommandActions + MOV EDX, dword ptr [EDX].TCommandActionsObj.aTextAlignRight + {$ELSE} MOV EDX, dword ptr [EAX].fCommandActions.aTextAlignRight + {$ENDIF} XOR EAX, EAX AND DX, CX JNZ @@ret_1 @@ -8422,28 +9506,51 @@ end; procedure TControl.SetTextAlign(const Value: TTextAlign); asm + {$IFDEF COMMANDACTIONS_OBJ} + PUSH EBX + {$ENDIF} MOV [EAX].fTextAlign, DL XOR ECX, ECX + {$IFDEF COMMANDACTIONS_OBJ} + MOV EBX, [EAX].fCommandActions + MOV CX, [EBX].TCommandActionsObj.aTextAlignLeft + OR CX, [EBX].TCommandActionsObj.aTextAlignCenter + OR CX, [EBX].TCommandActionsObj.aTextAlignRight + {$ELSE} MOV CX, [EAX].fCommandActions.aTextAlignLeft OR CX, [EAX].fCommandActions.aTextAlignCenter OR CX, [EAX].fCommandActions.aTextAlignRight + {$ENDIF} NOT ECX AND ECX, [EAX].fStyle AND EDX, 3 + {$IFDEF COMMANDACTIONS_OBJ} + OR CX, [EBX + EDX * 2].TCommandActionsObj.aTextAlignLeft + MOV DL, BYTE PTR [EBX].TCommandActionsObj.bTextAlignMask + {$ELSE} OR CX, [EAX + EDX * 2].fCommandActions.aTextAlignLeft + MOV DL, BYTE PTR [EAX].fCommandActions.bTextAlignMask + {$ENDIF} - MOV DL, [EAX].fCommandActions.aTextAlignMask NOT EDX AND EDX, ECX CALL SetStyle + {$IFDEF COMMANDACTIONS_OBJ} + POP EBX + {$ENDIF} end; function TControl.GetVerticalAlign: TVerticalAlign; asm PUSH EAX CALL UpdateWndStyles - MOV EDX, dword ptr [EAX].fCommandActions.aVertAlignCenter + {$IFDEF COMMANDACTIONS_OBJ} + MOV EDX, [EAX].fCommandActions + MOV EDX, dword ptr [EDX].TCommandActionsObj.bVertAlignCenter + {$ELSE} + MOV EDX, dword ptr [EAX].fCommandActions.bVertAlignCenter + {$ENDIF} MOV ECX, [EAX].fStyle XOR EAX, EAX MOV DH, DL @@ -8471,7 +9578,12 @@ asm MOVZX EBX, DL MOV [EAX].fVerticalAlign, BL - MOV ECX, dword ptr [EAX].fCommandActions.aVertAlignCenter + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOV ECX, dword ptr [ECX].TCommandActionsObj.bVertAlignCenter + {$ELSE} + MOV ECX, dword ptr [EAX].fCommandActions.bVertAlignCenter + {$ENDIF} OR CH, CL SHR ECX, 8 OR CL, CH @@ -8479,7 +9591,12 @@ asm MOV EDX, [EAX].fStyle AND DH, CL - OR DH, [EAX+EBX].fCommandActions.aVertAlignCenter + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + OR DH, [ECX+EBX].TCommandActionsObj.bVertAlignCenter + {$ELSE} + OR DH, [EAX+EBX].fCommandActions.bVertAlignCenter + {$ENDIF} POP EBX CALL SetStyle end; @@ -8550,21 +9667,54 @@ asm POP EBX end; +procedure TControl.SetDoubleBuffered(const Value: Boolean); +asm + {$IFDEF USE_FLAGS} + TEST [EAX].fFlagsG1, 1 shl G1_CanNotDoubleBuf + JNZ @@exit + {$ELSE} + CMP [EAX].fCannotDoubleBuf, 0 + JNZ @@exit + {$ENDIF} + {$IFDEF USE_FLAGS} + SHL DL, G2_DoubleBuffered + AND [EAX].fFlagsG2, not(1 shl G2_DoubleBuffered) + OR [EAX].fFlagsG2, DL + {$ELSE} + MOV [EAX].fDoubleBuffered, DL + {$ENDIF} + MOV EDX, offset[WndProcTransparent] + CALL TControl.AttachProc + {$IFnDEF SMALLEST_CODE} + LEA EAX, [TransparentAttachProcExtension] + MOV [Global_AttachProcExtension], EAX + {$ENDIF} +@@exit: +end; + procedure TControl.SetTransparent(const Value: Boolean); asm - MOV [EAX].fTransparent, DL MOV ECX, [EAX].fParent JECXZ @@exit + {$IFDEF USE_FLAGS} + AND [EAX].fFlagsG2, not(1 shl G2_Transparent) TEST DL, DL JZ @@exit + OR [EAX].fFlagsG2, 1 shl G2_Transparent + {$ELSE} + MOV [EAX].fTransparent, DL + TEST DL, DL + JZ @@exit + {$ENDIF} {$IFDEF GRAPHCTL_XPSTYLES} CMP AppTheming, FALSE JNE @@not_th - PUSH EBX - MOV BL, [EAX].fTransparent - MOV [EAX].fClassicTransparent, BL; - POP EBX + {$IFDEF USE_FLAGS} + OR [EAX].fFlagsG3, G3_ClassicTransparent + {$ELSE} + MOV [EAX].fClassicTransparent, DL + {$ENDIF USE_FLAGS} @@not_th: {$ENDIF} @@ -8986,6 +10136,202 @@ asm CALL RemoveStr end; +procedure SortData( const Data: Pointer; const uNElem: Dword; + const CompareFun: TCompareEvent; + const SwapProc: TSwapEvent ); +asm + CMP EDX, 2 + JL @@exit + + PUSH EAX // [EBP-4] = Data + PUSH ECX // [EBP-8] = CompareFun + PUSH EBX // EBX = pivotP + XOR EBX, EBX + INC EBX // EBX = 1 to pass to qSortHelp as PivotP + MOV EAX, EDX // EAX = nElem + CALL @@qSortHelp + POP EBX + POP ECX + POP ECX +@@exit: + POP EBP + RET 4 + +@@qSortHelp: + PUSH EBX // EBX (in) = PivotP + PUSH ESI // ESI = leftP + PUSH EDI // EDI = rightP + +@@TailRecursion: + CMP EAX, 2 + JG @@2 + JNE @@exit_qSortHelp + LEA ECX, [EBX+1] + MOV EDX, EBX + CALL @@Compare + JLE @@exit_qSortHelp +@@swp_exit: + CALL @@Swap +@@exit_qSortHelp: + POP EDI + POP ESI + POP EBX + RET + + // ESI = leftP + // EDI = rightP +@@2: LEA EDI, [EAX+EBX-1] + MOV ESI, EAX + SHR ESI, 1 + ADD ESI, EBX + MOV ECX, ESI + MOV EDX, EDI + CALL @@CompareLeSwap + MOV EDX, EBX + CALL @@Compare + + JG @@4 + CALL @@Swap + JMP @@5 +@@4: MOV ECX, EBX + MOV EDX, EDI + CALL @@CompareLeSwap +@@5: + CMP EAX, 3 + JNE @@6 + MOV EDX, EBX + MOV ECX, ESI + JMP @@swp_exit +@@6: // classic Horae algorithm + + PUSH EAX // EAX = pivotEnd + LEA EAX, [EBX+1] + MOV ESI, EAX +@@repeat: + MOV EDX, ESI + MOV ECX, EBX + CALL @@Compare + JG @@while2 +@@while1: + JNE @@7 + MOV EDX, ESI + MOV ECX, EAX + CALL @@Swap + INC EAX +@@7: + CMP ESI, EDI + JGE @@qBreak + INC ESI + JMP @@repeat +@@while2: + CMP ESI, EDI + JGE @@until + MOV EDX, EBX + MOV ECX, EDI + CALL @@Compare + JGE @@8 + DEC EDI + JMP @@while2 +@@8: + MOV EDX, ESI + MOV ECX, EDI + PUSHFD + CALL @@Swap + POPFD + JE @@until + INC ESI + DEC EDI +@@until: + CMP ESI, EDI + JL @@repeat +@@qBreak: + MOV EDX, ESI + MOV ECX, EBX + CALL @@Compare + JG @@9 + INC ESI +@@9: + PUSH EBX // EBX = PivotTemp + PUSH ESI // ESI = leftTemp + DEC ESI +@@while3: + CMP EBX, EAX + JGE @@while3_break + CMP ESI, EAX + JL @@while3_break + MOV EDX, EBX + MOV ECX, ESI + CALL @@Swap + INC EBX + DEC ESI + JMP @@while3 +@@while3_break: + POP ESI + POP EBX + + MOV EDX, EAX + POP EAX // EAX = nElem + PUSH EDI // EDI = lNum + MOV EDI, ESI + SUB EDI, EDX + ADD EAX, EBX + SUB EAX, ESI + + PUSH EBX + PUSH EAX + CMP EAX, EDI + JGE @@10 + + MOV EBX, ESI + CALL @@qSortHelp + POP EAX + MOV EAX, EDI + POP EBX + JMP @@11 + +@@10: MOV EAX, EDI + CALL @@qSortHelp + POP EAX + POP EBX + MOV EBX, ESI +@@11: + POP EDI + JMP @@TailRecursion + +@@Compare: + PUSH EAX + PUSH EDX + PUSH ECX + MOV EAX, [EBP-4] + DEC EDX + DEC ECX + CALL dword ptr [EBP-8] + POP ECX + POP EDX + TEST EAX, EAX + POP EAX + RET + +@@CompareLeSwap: + CALL @@Compare + JG @@ret + +@@Swap: PUSH EAX + PUSH EDX + PUSH ECX + MOV EAX, [EBP-4] + DEC EDX + DEC ECX + CALL dword ptr [SwapProc] + POP ECX + POP EDX + TEST EAX, EAX + POP EAX +@@ret: + RET + +end; + function CompareIntegers( const Sender : Pointer; const e1, e2 : DWORD ) : Integer; asm MOV EDX, [EAX+EDX*4] @@ -9012,214 +10358,6 @@ asm MOV [EDX], EAX end; -function _NewStatusbar( AParent: PControl ): PControl; -const STAT_CLS_NAM: PKOLChar = STATUSCLASSNAME; -asm - PUSH 0 - PUSH 0 - CMP [EAX].TControl.fSizeGrip, 0 - MOV ECX, WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or 3 or WS_VISIBLE - JZ @@1 - INC CH - AND CL, not 3 -@@1: - MOV EDX, [STAT_CLS_NAM] - CALL _NewCommonControl - PUSH EBX - XCHG EBX, EAX - PUSH EDI - LEA EDI, [EBX].TControl.fBoundsRect - XOR EAX, EAX - STOSD - STOSD - STOSD - STOSD - MOV [EBX].TControl.fAlign, caBottom - INC [EBX].TControl.fNotUseAlign - POP EDI - MOV EAX, EBX - CALL InitCommonControlSizeNotify - XCHG EAX, EBX - POP EBX -end; - -procedure TControl.SetStatusText(Index: Integer; Value: PKOLChar); -asm - PUSHAD - MOV EBX, EDX // EBX = Index - MOV ESI, EAX // ESI = @Self - - PUSH Value // prepare value for call at the end of procedure - PUSH EBX // prepare Index for call at the end of procedure - - MOV ECX, [ESI].fStatusCtl - INC ECX - LOOP @@status_created - - CALL GetClientHeight - PUSH EAX // ch = old client height - - MOV EAX, ESI - CALL _NewStatusBar - MOV [ESI].fStatusCtl, EAX - PUSH EAX //-----------v - - CALL TControl.GetWindowHandle - MOV [ESI].fStatusWnd, EAX - XCHG EDI, EAX - POP EAX //-----------^ - - XOR EDX, EDX - PUSH EDX - INC DH - DEC EDX - CMP EBX, EDX - SETZ DL - NEG EDX - -@@1: PUSH EDX - PUSH SB_SIMPLE - - PUSH EAX - CALL TControl.Perform - - ADD ESP, -16 - PUSH ESP - PUSH [ESI].fStatusWnd - CALL GetWindowRect - POP EAX - POP EDX - POP EAX - POP EAX - SUB EAX, EDX - MOV [ESI].fClientBottom, EAX - - POP EDX // ch - - PUSH 0 - PUSH 0 - PUSH WM_SIZE - PUSH EDI - - MOV EAX, ESI - CALL TControl.SetClientHeight - - CALL SendMessage - -@@status_created: - CMP EBX, 255 - JGE @@not_simple - - PUSH 0 - PUSH 0 - PUSH SB_GETPARTS - PUSH [ESI].fStatusWnd - CALL SendMessage - - CMP EAX, EBX - JG @@reset_simple - - MOV EAX, ESI - CALL GetWidth - CDQ - MOV ECX, EBX - INC ECX - IDIV ECX - MOV EDX, EAX - - ADD ESP, -1024 - MOV ECX, EBX - MOV EDI, ESP - JECXZ @@2 - -@@store_loo: - STOSD - ADD EAX, EDX - LOOP @@store_loo -@@2: - OR dword ptr [ESP+EBX*4], -1 - PUSH ESP - INC EBX - PUSH EBX - PUSH SB_SETPARTS - PUSH [ESI].fStatusWnd - CALL SendMessage - ADD ESP, 1024 - -@@reset_simple: - PUSH 0 - PUSH 0 - PUSH SB_SIMPLE - PUSH [ESI].fStatusWnd - CALL SendMessage - -@@not_simple: - PUSH SB_SETTEXT - PUSH [ESI].fStatusWnd - CALL SendMessage - POPAD -end; - -function TControl.GetStatusText( Index: Integer ): PKOLChar; -asm - MOV ECX, [EAX].fStatusWnd - JECXZ @@exit - - PUSH EBX - PUSH ESI - XCHG ESI, EAX // ESI = @Self - MOV EBX, EDX // EBX = Index - - XOR EAX, EAX - XCHG EAX, [ESI].fStatusTxt - TEST EAX, EAX - JZ @@1 - CALL System.@FreeMem -@@1: - XOR EAX, EAX - CDQ - MOV DL, WM_GETTEXTLENGTH - PUSH WM_GETTEXT - CMP EBX, 255 - JZ @@2 - POP EAX - MOV EAX, EBX - MOV DX, SB_GETTEXTLENGTH - PUSH SB_GETTEXT -@@2: - MOV EBX, EAX - - PUSH 0 - PUSH EAX - PUSH EDX - PUSH [ESI].fStatusWnd - CALL SendMessage - TEST AX, AX - JZ @@get_rslt - - PUSH EAX - INC EAX - CALL System.@GetMem - POP EDX - MOV [ESI].fStatusTxt, EAX - MOV byte ptr [EAX+EDX], 0 - - POP EDX // Msg - PUSH EAX - PUSH EBX - PUSH EDX - PUSH [ESI].fStatusWnd - CALL SendMessage - PUSH EDX -@@get_rslt: - POP EDX - MOV ECX, [ESI].fStatusTxt - POP ESI - POP EBX - -@@exit: XCHG EAX, ECX -end; - procedure TControl.RemoveStatus; asm MOV ECX, [EAX].fStatusCtl @@ -9228,14 +10366,12 @@ asm MOV EBX, EAX CALL GetClientHeight PUSH EAX - CDQ - MOV [EBX].fStatusWnd, EDX - XCHG EAX, EDX + XOR EAX, EAX XCHG [EBX].fStatusCtl, EAX CALL TObj.RefDec POP EAX CDQ - MOV [EBX].fClientBottom, EDX + MOV [EBX].fClientBottom, DL XCHG EDX, EAX XCHG EAX, EBX POP EBX @@ -9245,20 +10381,19 @@ end; function TControl.StatusPanelCount: Integer; asm - MOV EAX, [EAX].fStatusWnd - TEST EAX, EAX - JZ @@exit + MOV ECX, [EAX].fStatusCtl + JECXZ @@exit PUSH 0 PUSH 0 PUSH SB_GETPARTS - PUSH EAX - CALL SendMessage + PUSH ECX + CALL Perform @@exit: end; function TControl.GetStatusPanelX(Idx: Integer): Integer; asm - MOV ECX, [EAX].fStatusWnd + MOV ECX, [EAX].fStatusCtl JECXZ @@exit PUSH EBX MOV EBX, EDX @@ -9270,7 +10405,7 @@ asm MOV DX, SB_GETPARTS PUSH EDX PUSH ECX - CALL SendMessage + CALL Perform CMP EAX, EBX MOV ECX, [ESP+EBX*4] JG @@1 @@ -9284,7 +10419,7 @@ end; procedure TControl.SetStatusPanelX(Idx: Integer; const Value: Integer); asm ADD ESP, -1024 - MOV EAX, [EAX].fStatusWnd + MOV EAX, [EAX].fStatusCtl TEST EAX, EAX JZ @@exit @@ -9301,7 +10436,7 @@ asm PUSH 255 PUSH SB_GETPARTS PUSH EAX - CALL SendMessage + CALL Perform POP ECX POP EDX @@ -9312,7 +10447,7 @@ asm @@1: MOV [ESP+8], EAX MOV [ESP+16+EDX*4], ECX - CALL SendMessage + CALL Perform @@exit: ADD ESP, 1024 end; @@ -9644,11 +10779,11 @@ asm MOV ESI, ECX MOV EBX, EAX PUSHAD - MOV ECX, [EBX].fTBttCmd + MOV ECX, [EBX].DF.fTBttCmd INC ECX LOOP @@1 CALL NewList - MOV [EBX].fTBttCmd, EAX + MOV [EBX].DF.fTBttCmd, EAX {$IFDEF USE_AUTOFREE4CONTROLS} XCHG EDX, EAX MOV EAX, EBX @@ -9659,7 +10794,7 @@ asm {$ELSE} CALL NewStrList {$ENDIF} - MOV [EBX].fTBttTxt, EAX + MOV [EBX].DF.fTBttTxt, EAX {$IFDEF USE_AUTOFREE4CONTROLS} XCHG EDX, EAX MOV EAX, EBX @@ -9686,17 +10821,17 @@ asm {$ENDIF} MOV EDX, [ESP+4] - MOV EAX, [EBX].fTBttCmd + MOV EAX, [EBX].DF.fTBttCmd CALL TList.IndexOf TEST EAX, EAX JGE @@2 MOV EDX, [ESP+4] - MOV EAX, [EBX].fTBttCmd + MOV EAX, [EBX].DF.fTBttCmd CALL TList.Add POP EDX PUSH EDX - MOV EAX, [EBX].fTBttTxt + MOV EAX, [EBX].DF.fTBttTxt {$IFDEF UNICODE_CTRLS} CALL TWStrList.Add {$ELSE} @@ -9708,7 +10843,7 @@ asm MOV EDX, EAX POP ECX PUSH ECX - MOV EAX, [EBX].fTBttTxt + MOV EAX, [EBX].DF.fTBttTxt {$IFDEF UNICODE_CTRLS} CALL TWStrList.Put {$ELSE} @@ -9849,7 +10984,12 @@ asm CALL EDX2PChar PUSH EDX PUSH ECX + {$IFDEF COMMANDACTIONS_OBJ} + MOV ECX, [EAX].fCommandActions + MOVZX ECX, [ECX].TCommandActionsObj.aDir + {$ELSE} MOVZX ECX, [EAX].fCommandActions.aDir + {$ENDIF} JECXZ @@exit PUSH ECX PUSH EAX @@ -9941,10 +11081,15 @@ asm INC ECX MOV EDX, offset[EmptyString] XOR EAX, EAX + PUSH EAX CALL _NewWindowed MOV [TimerOwnerWnd], EAX MOV [EAX].TControl.fStyle, 0 + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG3, 1 shl G3_IsControl + {$ELSE} INC [EAX].TControl.fIsControl + {$ENDIF} XCHG ECX, EAX {$ENDIF} @@ -12330,11 +13475,7 @@ 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 @@ -12538,11 +13679,7 @@ 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 @@ -12671,7 +13808,6 @@ asm POP EBX end; -(* procedure TBitmap.CopyRect(const DstRect: TRect; SrcBmp: PBitmap; const SrcRect: TRect); asm @@ -12733,7 +13869,6 @@ asm @@exit: POPAD end; -*) procedure asmIconEmpty( Icon: PIcon ); asm @@ -12919,7 +14054,7 @@ asm //cmd //opd POP EBX end; -{$IFNDEF OLD_ALIGN} +{$IFnDEF OLD_ALIGN} procedure AlignChildrenProc(Sender: PObj); const AlignModes = (1 shl byte(caBottom))+(1 shl byte(caTop))+ (((1 shl byte(caRight)) +(1 shl byte(caLeft)))shl 8)+ @@ -12929,7 +14064,13 @@ asm //cmd //opd JZ @@21 CMP [EAX].TControl.fParent,0 SETZ DL - OR DL,[EAX].TControl.fisForm + {$IFDEF USE_FLAGS} + TEST [EAX].TControl.fFlagsG3, (1 shl G3_IsForm) + SETNZ DH + OR DL, DH + {$ELSE} + OR DL,[EAX].TControl.fIsForm + {$ENDIF} BTR dword ptr[EAX].TControl.fAligning,oaFromSelf JA @@20 OR byte ptr[EAX].TControl.fAligning,(1 shl oaWaitAlign) @@ -12939,10 +14080,27 @@ asm //cmd //opd @@21: RETN @@ToBeAlign: + {$IFDEF USE_FLAGS} + TEST [EAX].TControl.fStyle.f3_Style, 1 shl F3_Visible + SETNZ DL + {$ELSE} MOV DL,[EAX].TControl.fVisible + {$ENDIF} + {$IFDEF USE_FLAGS} + TEST [EAX].TControl.fFlagsG3, 1 shl G3_IsForm + SETNZ DH + OR DL, DH + {$ELSE} OR DL,[EAX].TControl.fCreateHidden + {$ENDIF} JE @@10 - AND DL,[EAX].TControl.fisForm + {$IFDEF USE_FLAGS} + TEST [EAX].TControl.fFlagsG3, 1 shl G3_IsForm + SETNZ DH + AND DL, DH + {$ELSE} + AND DL,[EAX].TControl.fIsForm + {$ENDIF} JNE @@12 CMP dword ptr[EAX].TControl.fParent,0 JE @@11 @@ -12977,13 +14135,24 @@ asm //cmd //opd JMP @@entry @@loop: MOV ESI,[EBP] + {$IFDEF USE_FLAGS} + MOV AL,[ESI].TControl.fStyle.f3_Style + SHR AL, F3_Visible + OR AL,[ESI].TControl.fFlagsG4 + AND AL, 1 shl G4_CreateHidden // G4_CreateHidden = 0 !!! + {$ELSE} MOV AL,[ESI].TControl.fVisible OR AL,[ESI].TControl.fCreateHidden + {$ENDIF} JZ @@continue MOVZX EAX,[ESI].TControl.fAlign BT [ESP+30h],EAX //Allowed JNC @@continue + {$IFDEF USE_FLAGS} + TEST [ESI].TControl.fFlagsG4, 1 shl G4_NotUseAlign + {$ELSE} CMP byte ptr[ESI].TControl.fNotUseAlign,0 + {$ENDIF} JNE @@align MOV EDX,ESP //@R MOV EAX,ESI //C @@ -12998,7 +14167,7 @@ asm //cmd //opd MOV EAX,[ESP] //R.Left MOV [ESP+10h],EAX //R1.Left SUB [ESP+18h],EAX //W - MOV EDX,[EBX].TControl.fMargin + MOVSX EDX,[EBX].TControl.fMargin MOVZX ECX,byte ptr[ESI].TControl.fAlign //!!! Order of caXXX-constants is important LOOP @@caTop @@ -13120,7 +14289,7 @@ function WndProcUpdate( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Bo asm //cmd //opd PUSH EBX XCHG EBX, EAX - MOV EAX, [EBX].TControl.fUpdateCount + MOVZX EAX, [EBX].TControl.fUpdateCount TEST EAX, EAX JZ @@exit @@ -13151,7 +14320,7 @@ asm PUSH EBX PUSH ECX XCHG EBX, EAX MOV EDI, EDX - MOV [EBX].fOnDynHandlers, offset[EnumDynHandlers] + MOV [EBX].PP.fOnDynHandlers, offset[EnumDynHandlers] MOV EAX, [EBX].fDynHandlers MOV EDX, EDI CALL TList.IndexOf @@ -13177,15 +14346,62 @@ end; function TControl.IsProcAttached(Proc: TWindowFunc): Boolean; asm //cmd //opd - //MOV ECX, [EAX].TControl.fDynHandlers MOV EAX, [EAX].TControl.fDynHandlers - //JECXZ @@exit - //XCHG EAX, ECX CALL TList.IndexOf TEST EAX, EAX - //SETGE CL SETGE AL -//@@exit: XCHG EAX, ECX +end; + +function TControl.GetToBeVisible: Boolean; +asm + {$IFDEF USE_FLAGS} + TEST [EAX].TControl.fStyle.f3_Style, 1 shl F3_Visible + SETNZ DH + TEST [EAX].TControl.fFlagsG4, (1 shl G4_CreateHidden) or (1 shl G4_VisibleWOParent) + SETNZ DL + OR DL, DH + TEST [EAX].TControl.fFlagsG3, 1 shl G3_IsControl + JZ @@retDL + MOV ECX, [EAX].TControl.fParent + JECXZ @@retDL + + {$IFDEF OLD_ALIGN} + TEST [EAX].TControl.fFlagsG4, 1 shl G4_VisibleWOParent + JZ @@1 + MOV DL, DH + JMP @@retDL + {$ENDIF} + + {$ELSE not USE_FLAGS} + MOV DH, [EAX].TControl.fVisible + MOV DL, [EAX].TControl.fCreateHidden + OR DL, DH + OR DL, [EAX].TControl.fVisibleWoParent + CMP [EAX].TControl.fIsControl, 0 + JZ @@retDL + MOV ECX, [EAX].TControl.fParent + JECXZ @@retDL + + {$IFDEF OLD_ALIGN} + CMP [EAX].TControl.fVisibleWoParent + JZ @@1 + MOV DL, DH + JMP @@retDL + {$ENDIF} + + {$ENDIF} + +@@1: + TEST DL, DL + JZ @@retDL + XCHG EAX, ECX + PUSH EAX + CALL TControl.Get_Visible + POP EAX + CALL TControl.GetToBeVisible + XCHG EDX, EAX +@@retDL: + XCHG EAX, EDX end; // by MTsv DN - v2.90 -- chg by VK @@ -13240,7 +14456,892 @@ asm @@save_exit: MOV byte ptr [SaveWinVer], AL @@exit: -end; +end; +function TControl.MakeWordWrap: PControl; +asm + {$IFDEF USE_FLAGS} + OR [EAX].TControl.fFlagsG1, (1 shl G1_WordWrap) + {$ELSE} + MOV [EAX].TControl.fWordWrap, 1 + {$ENDIF} + AND byte ptr[EAX].TControl.fStyle.f0_Style, not SS_LEFTNOWORDWRAP + PUSH EAX + MOV EDX, [EAX].TControl.fStyle + CALL TControl.SetStyle + POP EAX +end; + +function TControl.FormGetIntParam: Integer; +asm + PUSH ESI + PUSH EDI + MOV EDI, EAX // EDX = @ Self + + XOR EDX, EDX +@@loop: + + LEA ECX, [EDI].DF.FormParams + MOV ESI, DWORD PTR[ECX] + LODSB + MOV DWORD PTR[ECX], ESI + + SHR AL, 1 + JNC @@nocont + + SHL EDX, 7 + OR DL, AL + JMP @@loop + +@@nocont: + + SHR AL, 1 + PUSHF + XCHG EDX, EAX + SHL EAX, 6 + OR AL, DL + POPF + JNC @@noneg + + NEG EAX +@@noneg: + POP EDI + POP ESI +end; + +function TControl.FormGetColorParam: Integer; +asm + CALL FormGetIntParam + ROR EAX, 1 +end; + +procedure TControl.FormGetStrParam; +asm + PUSH EDI + MOV EDI, EAX + CALL FormGetIntParam + XCHG ECX, EAX + LEA EAX, [EDI].FormString + PUSH ECX + MOV EDX, DWORD PTR[EDI].DF.FormParams + {$IFDEF _D2} + CALL System.@LStrFromLenStr + {$ELSE} + CALL System.@LStrFromPCharLen + {$ENDIF} + POP ECX + ADD DWORD PTR[EDI].DF.FormParams, ECX + POP EDI +end; + +procedure TControl.FormExecuteCommands(AForm: PControl; ControlPtrOffsets: PSmallIntArray); +asm + PUSH EBX + PUSH ESI + PUSH EDI + XCHG EDI, EAX // EDI = @ Self + MOV EBX, EDX // EBX = AForm + MOV ESI, ECX // ECX = @ ControlPtrOffsets[0] +@@while_do: + MOV EAX, EDI + CALL FormGetIntParam + TEST EAX, EAX + JZ @@ewhile + JG @@not_create_ctrl + + NEG EAX + MOV ECX, [EDI].DF.FormAlphabet + MOV ECX, [ECX+EAX*4-4] + + MOV EAX, EDI + + CALL ECX + XCHG ECX, EAX + + XOR EAX, EAX + LODSW + MOV DWORD PTR[EBX+EAX*4], ECX + MOV [EDI].DF.FormLastCreatedChild, ECX + JMP @@while_do + +@@not_create_ctrl: + MOV ECX, [EDI].DF.FormAlphabet + MOV ECX, [ECX+EAX*4-4] + MOV EAX, [EDI].DF.FormLastCreatedChild + + XOR EDX, EDX + INC EDX + + CALL ECX + JMP @@while_do + +@@ewhile: + LEA EAX, [EDI].FormString + CALL System.@LStrClr + + POP EDI + POP ESI + POP EBX +end; + +function FormNewLabel( Form: PControl ): PControl; +asm + CALL FormPrepareStrParamCreateCtrl + CALL NewLabel +end; + +function FormNewWordWrapLabel( Form: PControl ): PControl; +asm + CALL FormPrepareStrParamCreateCtrl + CALL NewWordWrapLabel +end; + +function FormNewLabelEffect( Form: PControl ): PControl; +asm + PUSH EAX + CALL TControl.FormGetStrParam + POP EAX + PUSH EAX + CALL TControl.FormGetIntParam + POP ECX + PUSH EAX + LEA ECX, [ECX].TControl.DF.FormCurrentParent + MOV EAX, [ECX] + MOV EDX, [ECX+4] + POP ECX + CALL NewLabelEffect +end; + +function FormNewButton( Form: PControl ): PControl; +asm + CALL FormPrepareStrParamCreateCtrl + CALL NewButton +end; + +function FormNewPanel( Form: PControl ): PControl; +asm + CALL FormPrepareIntParamCreateCtrl + CALL NewPanel +end; + +function FormNewGroupbox( Form: PControl ): PControl; +asm + CALL FormPrepareStrParamCreateCtrl + CALL NewGroupbox +end; + +function FormNewEditBox( Form: PControl ): PControl; +asm + CALL FormPrepareIntParamCreateCtrl + CALL NewEditBox +end; + +function FormNewComboBox( Form: PControl ): PControl; +asm + CALL FormPrepareIntParamCreateCtrl + CALL NewCombobox +end; + +function FormNewCheckbox( Form: PControl ): PControl; +asm + CALL FormPrepareStrParamCreateCtrl + CALL NewCheckbox +end; + +function FormNewRadiobox( Form: PControl ): PControl; +asm + CALL FormPrepareStrParamCreateCtrl + CALL NewRadiobox +end; + +function FormNewListbox( Form: PControl ): PControl; +asm + CALL FormPrepareIntParamCreateCtrl + CALL NewListbox +end; + +procedure FormSetSize( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL ParentForm_IntParamAsm + //XCHG ECX, EDX + POP EDX + CALL TControl.SetSize +end; + +procedure FormSetPosition( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL ParentForm_IntParamAsm + POP EDX + CALL TControl.SetPosition +end; + +procedure FormSetClientSize( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL ParentForm_IntParamAsm + //XCHG ECX, EDX + POP EDX + CALL TControl.SetClientSize +end; + +procedure FormSetAlign( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetAlign +end; + +procedure FormSetCanResizeFalse( Form: PControl ); +asm + XOR EDX, EDX + CALL TControl.SetCanResize +end; + +procedure FormInitMenu( Form: PControl ); +asm + PUSH 0 + PUSH 0 + PUSH WM_INITMENU + PUSH EAX + CALL TControl.Perform +end; + +procedure FormSetExStyle( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + OR EDX, [EAX].TControl.fExStyle + CALL TControl.SetExStyle +end; + +procedure FormSetVisibleFalse( Form: PControl ); +asm + XOR EDX, EDX + CALL TControl.SetVisible +end; + +procedure FormSetEnabledFalse( Form: PControl ); +asm + XOR EDX, EDX + CALL TControl.SetEnabled +end; + +procedure FormResetStyles( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + NOT EDX + AND EDX, [EAX].TControl.fStyle + CALL TControl.SetStyle +end; + +procedure FormSetStyle( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + OR EDX, [EAX].TControl.fStyle + CALL TControl.SetStyle +end; + +procedure FormSetAlphaBlend( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetAlphaBlend +end; + +procedure FormSetHasBorderFalse( Form: PControl ); +asm + XOR EDX, EDX + CALL TControl.SetHasBorder +end; + +procedure FormSetHasCaptionFalse( Form: PControl ); +asm + XOR EDX, EDX + CALL TControl.SetHasCaption +end; + +procedure FormResetCtl3D( Form: PControl ); +asm + XOR EDX, EDX + CALL TControl.SetCtl3D +end; + +procedure FormIconLoad_hInstance( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + MOV EDX, [hInstance] + CALL TControl.IconLoad +end; + +procedure FormIconLoadCursor_0( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + XOR EDX, EDX + CALL TControl.IconLoadCursor +end; + +procedure FormSetIconNeg1( Form: PControl ); +asm + OR EDX, -1 + CALL TControl.SetIcon +end; + +procedure FormSetWindowState( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetWindowState +end; + +procedure FormCursorLoad_0( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + XOR EDX, EDX + CALL TControl.CursorLoad +end; + +procedure FormSetColor( Form: PControl ); +asm + CALL ParentForm_ColorParamAsm + CALL TControl.SetCtlColor +end; + +procedure FormSetBrushStyle( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL TControl.GetBrush + POP EDX + CALL TGraphicTool.SetBrushStyle +end; + +procedure FormSetBrushBitmap( Form: PControl ); +asm + PUSH EDI + MOV EDI, EAX + CALL TControl.ParentForm + + PUSH EAX + CALL ParentForm_PCharParam + XCHG EDX, EAX + MOV EAX, [hInstance] + POP ECX + + CALL LoadBmp + + PUSH EAX + MOV EAX, EDI + CALL TControl.GetBrush + POP EDX + + CALL TGraphicTool.SetBrushBitmap + POP EDI +end; + +procedure FormSetFontColor( Form: PControl ); +asm + CALL ParentForm_ColorParamAsm + PUSH EDX + CALL TControl.GetFont + POP EDX + CALL TGraphicTool.SetColor +end; + +procedure FormSetFontStyles( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL TControl.GetFont + POP EDX + CALL TGraphicTool.SetFontStyle +end; + +procedure FormSetFontHeight( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL TControl.GetFont + XOR EDX, EDX + MOV DL, 4 + POP ECX + CALL TGraphicTool.SetInt +end; + +procedure FormSetFontWidth( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL TControl.GetFont + XOR EDX, EDX + MOV DL, 8 + POP ECX + CALL TGraphicTool.SetInt +end; + +procedure FormSetFontOrientation( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL TControl.GetFont + POP EDX + CALL TGraphicTool.SetFontOrientation +end; + +procedure FormSetFontCharset( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL TControl.GetFont + POP EDX + CALL TGraphicTool.SetFontCharset +end; + +procedure FormSetFontPitch( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL TControl.GetFont + POP EDX + CALL TGraphicTool.SetFontPitch +end; + +procedure FormSetBorder( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + MOV [EAX].TControl.fMargin, DL +end; + +procedure FormSetMarginTop( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + XOR EDX, EDX + INC EDX + CALL TControl.SetClientMargin +end; + +procedure FormSetMarginBottom( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + XOR EDX, EDX + MOV DL, 2 + CALL TControl.SetClientMargin +end; + +procedure FormSetMarginLeft( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + XOR EDX, EDX + MOV DL, 3 + CALL TControl.SetClientMargin +end; + +procedure FormSetMarginRight( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + XOR EDX, EDX + MOV DL, 4 + CALL TControl.SetClientMargin +end; + +procedure FormSetSimpleStatusText( Form: PControl ); +asm + CALL ParentForm_PCharParamAsm + XOR EDX, EDX + MOV DL, 255 + CALL TControl.SetStatusText +end; + +procedure FormSetStatusText( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL ParentForm_PCharParamAsm + POP EDX + CALL TControl.SetStatusText +end; + +procedure FormRemoveCloseIcon( Form: PControl ); +asm + PUSH MF_BYCOMMAND + PUSH SC_CLOSE + CALL TControl.GetWindowHandle + PUSH 0 + PUSH EAX + CALL GetSystemMenu + PUSH EAX + CALL DeleteMenu +end; + +procedure FormSetConstraint; +asm + MOVZX EDX, DL + PUSH EDX + CALL ParentForm_IntParamAsm + POP EDX + CALL TControl.SetConstraint +end; + +procedure FormSetMinWidth( Form: PControl ); +asm + XOR EDX, EDX + CALL FormSetConstraint +end; + +procedure FormSetMaxWidth( Form: PControl ); +asm + MOV DL, 2 + CALL FormSetConstraint +end; + +procedure FormSetMinHeight( Form: PControl ); +asm + MOV DL, 1 + CALL FormSetConstraint +end; + +procedure FormSetMaxHeight( Form: PControl ); +asm + MOV DL, 3 + CALL FormSetConstraint +end; + +procedure FormSetTextShiftX( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + MOV [EAX].TControl.DF.fTextShiftX, EDX +end; + +procedure FormSetTextShiftY( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + MOV [EAX].TControl.DF.fTextShiftY, EDX +end; + +procedure FormSetColor2( Form: PControl ); +asm + CALL ParentForm_ColorParamAsm + CALL TControl.SetColor2 +end; + +procedure FormSetTextAlign( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetTextAlign +end; + +procedure FormSetTextVAlign( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetVerticalAlign +end; + +procedure FormSetIgnoreDefault( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + {$IFDEF USE_FLAGS} + SHL EDX, G5_IgnoreDefault + AND [EAX].TControl.fFlagsG5, $7F //not(1 shl G5_IgnoreDefault) + OR [EAX].TControl.fFlagsG5, DL + {$ELSE} + MOV [EAX].TControl.FIgnoreDefault, DL + {$ENDIF} +end; + +procedure FormSetCaption( Form: PControl ); +asm + PUSH EAX + CALL TControl.ParentForm + PUSH EAX + CALL TControl.FormGetStrParam + POP EAX + MOV EDX, [EAX].TControl.FormString + POP EAX + CALL TControl.SetCaption +end; + +procedure FormSetGradienStyle( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetGradientStyle +end; + +{$IFDEF USE_RICHEDIT} +procedure FormSetRE_AutoFontFalse( Form: PControl ); +asm + XOR EDX, EDX + MOV DL, 4 + XOR ECX, ECX + CALL TControl.RESetLangOptions +end; + +procedure FormSetRE_AutoFontSizeAdjustFalse( Form: PControl ); +asm + XOR EDX, EDX + MOV DL, 16 + XOR ECX, ECX + CALL TControl.RESetLangOptions +end; + +procedure FormSetRE_DualFontTrue( Form: PControl ); +asm + XOR EDX, EDX + MOV DL, 128 + MOV CL, 1 + CALL TControl.RESetLangOptions +end; + +procedure FormSetRE_UIFontsTrue( Form: PControl ); +asm + XOR EDX, EDX + MOV DL, 32 + MOV CL, 1 + CALL TControl.RESetLangOptions +end; + +procedure FormSetRE_IMECancelCompleteTrue( Form: PControl ); +asm + XOR EDX, EDX + MOV DL, 4 + MOV CL, 1 + CALL TControl.RESetLangOptions +end; + +procedure FormSetRE_IMEAlwaysSendNotifyTrue( Form: PControl ); +asm + XOR EDX, EDX + MOV DL, 8 + MOV CL, 1 + CALL TControl.RESetLangOptions +end; + +procedure FormSetMaxTextSize( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetMaxTextSize +end; + +procedure FormSetRE_AutoKeyboardTrue( Form: PControl ); +asm + XOR EDX, EDX + MOV DL, 1 + MOV CL, 1 + CALL TControl.RESetLangOptions +end; + +procedure FormSetRE_Zoom( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL ParentForm_IntParamAsm + POP EDX + SHL ECX, 16 + OR EDX, ECX + CALL TControl.ReSetZoom +end; +{$ENDIF USE_RICHEDIT} + +procedure FormSetCount( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetItemsCount +end; + +procedure FormSetDroppedWidth( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetDroppedWidth +end; + +procedure FormSetButtonImage( Form: PControl ); +asm + PUSH EDI + MOV EDI, EAX + CALL ParentForm_IntParamAsm + PUSH ECX + CALL ParentForm_IntParamAsm + POP ECX + PUSH $8000 // LR_SHARED + PUSH ECX + PUSH EDX + PUSH IMAGE_ICON + CALL ParentForm_PCharParam + PUSH EAX + PUSH [hInstance] + CALL LoadImage + XCHG EDX, EAX + XCHG EAX, EDI + CALL TControl.SetButtonIcon + POP EDI +end; + +procedure FormSetButtonBitmap( Form: PControl ); +asm + PUSH EAX + CALL ParentForm_PCharParam + PUSH EAX + PUSH [hInstance] + CALL LoadBitmap + XCHG EDX, EAX + POP EAX + CALL TControl.SetButtonBitmap +end; + +procedure FormSetMaxProgress( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + MOV EDX, (PBM_SETRANGE32 or $8000) shl 16 + CALL TControl.SetMaxProgress +end; + +procedure FormSetProgress( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + MOV EDX, (PBM_SETPOS or $8000) shl 16 + CALL TControl.SetIntVal +end; + +procedure FormLVColumsAdd( Form: PControl ); +asm + PUSH EDI + MOV EDI, EAX + CALL ParentForm_IntParamAsm + JECXZ @@fin +@@1: + PUSH ECX + MOV EAX, EDI + CALL ParentForm_IntParamAsm + PUSH ECX + CALL ParentForm_StrParam + MOV EAX, EDI + CALL TControl.ParentForm + MOV EDX, [EAX].TControl.FormString + XOR ECX, ECX + MOV CL, taLeft + MOV EAX, EDI + CALL TControl.LVColAdd + POP ECX + LOOP @@1 +@@fin: + POP EDI +end; + +procedure FormSetLVColOrder( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL ParentForm_IntParamAsm + POP EDX + PUSH ECX + MOV ECX, LVCF_ORDER or (28 shl 16) + CALL TControl.SetLVColEx +end; + +procedure FormSetLVColImage( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSH EDX + CALL ParentForm_IntParamAsm + POP EDX + PUSH ECX + MOV ECX, LVCF_IMAGE or (24 shl 16) + CALL TControl.SetLVColEx +end; + +procedure FormSetTVIndent( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + MOV EDX, TVM_GETINDENT + CALL TControl.SetIntVal +end; + +procedure FormSetDateTimeFormat( Form: PControl ); +asm + PUSH EAX + CALL TControl.ParentForm + PUSH EAX + CALL TControl.FormGetStrParam + POP EAX + MOV EDX, [EAX].TControl.FormString + POP EAX + CALL TControl.SetDateTimeFormat +end; + +procedure FormSetCurrentTab( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + PUSHAD + CALL TControl.SetCurIndex + POPAD + CALL TControl.GetPages + CALL TControl.BringToFront +end; + +procedure FormSetCurIdx( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetCurIndex +end; + +procedure FormSetSBMin( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetSBMin +end; + +procedure FormSetSBMax( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetSBMax +end; + +procedure FormSetSBPosition( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetSBPosition +end; + +procedure FormSetSBPageSize( Form: PControl ); +asm + CALL ParentForm_IntParamAsm + CALL TControl.SetSBPageSize +end; + +procedure FormLastCreatedChildAsNewCurrentParent( Form: PControl ); +asm + PUSH EAX + CALL TControl.ParentForm + POP [EAX].TControl.DF.FormCurrentParent +end; + +procedure FormSetTabpageAsParent( Form: PControl ); +asm + PUSH EAX + CALL TControl.ParentForm + CALL ParentForm_IntParamAsm + POP ECX + PUSH EAX + XCHG EAX, ECX + CALL TControl.GetPages + POP EDX + MOV [EDX].TControl.DF.FormCurrentParent, EAX +end; + +procedure FormSetCurCtl( Form: PControl ); +asm + CALL TControl.ParentForm + CALL ParentForm_IntParamAsm + MOV ECX, [EAX].TControl.DF.FormAddress + MOV ECX, [ECX + EDX*4] + + TEST ECX, ECX + JNZ @@1 + MOV ECX, EAX + +@@1: + MOV [EAX].TControl.DF.FormLastCreatedChild, ECX +end; + +{$ENDIF} //======================================== THE END OF FILE KOL_ASM.inc diff --git a/KOL_ansi.inc b/KOL_ansi.inc index 8e34c0b..b40ef01 100644 --- a/KOL_ansi.inc +++ b/KOL_ansi.inc @@ -697,7 +697,7 @@ type TDeviceMode = TDeviceModeA; TFNOldFontEnumProc = TFNOldFontEnumProcA; TFNFontEnumProc = TFNFontEnumProcA; - MakeIntResource = MakeIntResourceA; + MakeIntResource = PAnsiChar; // MakeIntResourceA; //PMenuItemInfo = PMenuItemInfoA; //TMenuItemInfo = TMenuItemInfoA; //MENUITEMINFO = MENUITEMINFOA; @@ -1871,6 +1871,7 @@ function VkKeyScanEx(ch: KOLChar; dwhkl: HKL): SHORT; stdcall; function WinHelp(hWndMain: HWND; lpszHelp: PKOLChar; uCommand: UINT; dwData: DWORD): BOOL; stdcall; function wsprintf(Output: PKOLChar; Format: PKOLChar): Integer; stdcall; function wvsprintf(Output: PKOLChar; Format: PKOLChar; arglist: {$IFDEF UNICODE} PAnsiChar {$ELSE} va_list {$ENDIF}): Integer; stdcall; +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PAnsiChar): THandle; const IDC_ARROW = MakeIntResource(32512); @@ -2303,4 +2304,13 @@ function VkKeyScanEx; external user32 name 'VkKeyScanExA'; function WinHelp; external user32 name 'WinHelpA'; function wsprintf; external user32 name 'wsprintfA'; function wvsprintf; external user32 name 'wvsprintfA'; +// NT 4.0 bug workaround - NT 4.0 doesn't test bInitialOwner for zero/nonzero, it tests for 1 +function _CreateMutex(lpMutexAttributes: PSecurityAttributes; + bInitialOwner: Integer; lpName: PAnsiChar): THandle; stdcall; + external kernel32 name 'CreateMutexA'; +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PAnsiChar): THandle; +begin + Result := _CreateMutex(lpMutexAttributes, Integer(Boolean(bInitialOwner)), lpName); +end; + {$ENDIF implementation_part} /////////////////////////////////////////////////// diff --git a/KOL_unicode.inc b/KOL_unicode.inc index 09607dc..fdc5c60 100644 --- a/KOL_unicode.inc +++ b/KOL_unicode.inc @@ -734,6 +734,7 @@ function VkKeyScanEx(ch: KOLChar; dwhkl: HKL): SHORT; stdcall; function WinHelp(hWndMain: HWND; lpszHelp: PKOLChar; uCommand: UINT; dwData: DWORD): BOOL; stdcall; function wsprintf(Output: PKOLChar; Format: PKOLChar): Integer; stdcall; function wvsprintf(Output: PKOLChar; Format: PKOLChar; arglist: va_list): Integer; stdcall; +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PWideChar): THandle; const IDC_ARROW = MakeIntResource(32512); @@ -1172,4 +1173,12 @@ function VkKeyScanEx; external user32 name 'VkKeyScanExW'; function WinHelp; external user32 name 'WinHelpW'; function wsprintf; external user32 name 'wsprintfW'; function wvsprintf; external user32 name 'wvsprintfW'; +// NT 4.0 bug workaround - NT 4.0 doesn't test bInitialOwner for zero/nonzero, it tests for 1 +function _CreateMutex(lpMutexAttributes: PSecurityAttributes; + bInitialOwner: Integer; lpName: PWideChar): THandle; stdcall; + external kernel32 name 'CreateMutexW'; +function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName: PWideChar): THandle; +begin + Result := _CreateMutex(lpMutexAttributes, Integer(Boolean(bInitialOwner)), lpName); +end; {$ENDIF implementation_part} /////////////////////////////////////////////////// diff --git a/KOLadd.pas b/KOLadd.pas index 877b4a2..05e45e8 100644 --- a/KOLadd.pas +++ b/KOLadd.pas @@ -36,6 +36,11 @@ modified last time, this is not a version of KOLadd itself. {$IFDEF EXTERNAL_DEFINES} {$INCLUDE EXTERNAL_DEFINES.INC} {$ENDIF EXTERNAL_DEFINES} +{$IFDEF INPACKAGE} + {$IFDEF _D2009orHigher} + {$DEFINE UNICODE_CTRLS} + {$ENDIF} +{$ENDIF} unit KOLadd; @@ -56,10 +61,7 @@ uses Windows, Messages, KOL; | | (------------------------------------------------------------------------------} type - -//[TListEx DEFINITION] - {++}(*TListEx = class;*){--} - PListEx = {-}^{+}TListEx; + PListEx = ^TListEx; TListEx = object( TObj ) {* Extended list, with Objects[ ] property. Created calling NewListEx function. } protected @@ -71,7 +73,7 @@ type function GetAddBy: Integer; procedure Set_AddBy(const Value: Integer); public - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* } property AddBy: Integer read GetAddBy write Set_AddBy; {* } @@ -122,9 +124,7 @@ function NewListEx: PListEx; | | (------------------------------------------------------------------------------} type -//[TBits DEFINITION] - {++}(*TBits = class;*){--} - PBits = {-}^{+}TBits; + PBits = ^TBits; TBits = object( TObj ) {* Variable-length bits array object. Created using function NewBits. See also | @@ -139,7 +139,7 @@ type function GetSize: Integer; procedure SetCapacity(const Value: Integer); public - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* } property Bits[ Idx: Integer ]: Boolean read GetBit write SetBit; {* } @@ -214,8 +214,7 @@ type procedure Put(Idx: integer; const Value: AnsiString); procedure SetTextStr(const Value: AnsiString); function GetPChars( Idx: Integer ): PAnsiChar; - {++}(*public*){--} - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; public function AddAnsi( const S: AnsiString ): Integer; {* Adds Ansi AnsiString to a list. } @@ -332,10 +331,8 @@ var Upper: array[ Char ] of AnsiChar; procedure InitUpper; {* Call this fuction ones to fill Upper[ ] table before using it. } -//[CABINET FILES OBJECT] type - {++}(*TCabFile = class;*){--} - PCABFile = {-}^{+}TCABFile; + PCABFile = ^TCABFile; TOnNextCAB = function( Sender: PCABFile ): KOLString of object; TOnCABFile = function( Sender: PCABFile; var FileName: KOLString ): Boolean of object; @@ -351,8 +348,8 @@ type The only what need to use this object, setupapi.dll. It is provided with all latest versions of Windows. } protected - FPaths: {$IFDEF UNICODE_CTRLS} PWStrList {$ELSE} PStrList {$ENDIF}; - FNames: {$IFDEF UNICODE_CTRLS} PWStrList {$ELSE} PStrList {$ENDIF}; + FPaths: PKOLStrList; + FNames: PKOLStrList; FOnNextCAB: TOnNextCAB; FOnFile: TOnCABFile; FTargetPath: KOLString; @@ -365,7 +362,7 @@ type FGettingNames: Boolean; FCurCAB: Integer; public - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* } property Paths[ Idx: Integer ]: KOLString read GetPaths; {* A list of CAB-files. It is stored, when constructing function @@ -415,10 +412,8 @@ function OpenCABFile( const APaths: array of AnsiString ): PCABFile; will be called, or (and) user will be prompted to browse file during executing (i.e. Extracting). } -//[DIRCHANGE] type - {++}(*TDirChange = class;*){--} - PDirChange = {-}^{+}TDirChange; + PDirChange = ^TDirChange; {* } TOnDirChange = procedure (Sender: PDirChange; const Path: KOLString) of object; @@ -435,7 +430,6 @@ type TDirChange object ----------------------------------------------------------------------- } -//[TDirChange DEFINITION] TDirChange = object(TObj) {* Object type to monitor changes in certain folder. } protected @@ -446,8 +440,7 @@ type function Execute( Sender: PThread ): Integer; procedure Changed; protected - {++}(*public*){--} - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {*} public property Handle: THandle read FHandle; @@ -457,9 +450,7 @@ type is under monitoring). } property OnChange: TOnDirChange read FOnChange write FOnChange; end; -//[END OF TDirChange DEFINITION] -//[NewDirChangeNotifier DECLARATION] function NewDirChangeNotifier( const Path: KOLString; Filter: TFileChangeFilter; WatchSubtree: Boolean; ChangeProc: TOnDirChange ) : PDirChange; @@ -470,17 +461,13 @@ function NewDirChangeNotifier( const Path: KOLString; Filter: TFileChangeFilter; If empty filter is passed, default filter is used: [fncFileName..fncLastWrite]. } -//[METAFILES] - type - {++}(*TMetafile = class;*){--} - PMetafile = {-}^{+}TMetafile; + PMetafile = ^TMetafile; { ---------------------------------------------------------------------- TMetafile - Windows metafile and Enchanced Metafile image ----------------------------------------------------------------------- } -//[TMetafile DEFINITION] TMetafile = object( TObj ) {* Object type to incapsulate metafile image. } protected @@ -492,7 +479,7 @@ type fHeader: PEnhMetaHeader; procedure RetrieveHeader; public - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* } procedure Clear; {* } @@ -559,14 +546,11 @@ type UpdateProc: TOnUpdateCtrlEvent; end; - {++}(* TAction = class;*){--} - PAction = {-}^{+}TAction; + PAction = ^TAction; - {++}(* TActionList = class;*){--} - PActionList = {-}^{+}TActionList; + PActionList = ^TActionList; -//[TAction DEFINITION] - TAction = {-} object( TObj ) {+}{++}(*class*){--} + TAction = object( TObj ) {*! Use action objects, in conjunction with action lists, to centralize the response to user commands (actions). Use AddControl, AddMenuItem, AddToolbarButton methods to link controls to an action. @@ -604,7 +588,7 @@ type procedure UpdateToolbar(Sender: PControlRec); public - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; procedure LinkControl(Ctrl: PControl); {* Add a link to a TControl or descendant control. } procedure LinkMenuItem(Menu: PMenu; MenuItemIdx: integer); @@ -630,10 +614,8 @@ type property OnExecute: TOnEvent read FOnExecute write SetOnExecute; {* This event is executed when user clicks on a linked object or Execute method was called. } end; -//[END OF TAction DEFINITION] -//[TActionList DEFINITION] - TActionList = {-} object( TObj ) {+}{++}(*class*){--} + TActionList = object( TObj ) {*! TActionList maintains a list of actions used with components and controls, such as menu items and buttons. Action lists are used, in conjunction with actions, to centralize the response @@ -651,7 +633,7 @@ type protected procedure DoUpdateActions(Sender: PObj); public - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; function Add(const ACaption, AHint: KOLString; OnExecute: TOnEvent): PAction; {* Add a new action to the list. Returns pointer to action object. } procedure Delete(Idx: integer); @@ -666,18 +648,14 @@ type {* Event handler to update actions state. This event is called each time when application goes in the idle state (no messages in the queue). } end; -//[END OF TActionList DEFINITION] -//[NewActionList DECLARATION] function NewActionList(AOwner: PControl): PActionList; {* Action list constructor. AOwner - owner form. } { -- tree (non-visual) -- } type -//[TTree DEFINITION] - {++}(*TTree = class;*){--} - PTree = {-}^{+}TTree; + PTree = ^TTree; TTree = object( TObj ) {* Object to store tree-like data in memory (non-visual). } protected @@ -706,11 +684,9 @@ type constructor CreateTree( AParent: PTree; const AName: AnsiString ); {* } {$ENDIF} - {++}(*public*){--} - destructor Destroy; {-}virtual;{+}{++}(*override;*){--} + destructor Destroy; virtual; {* } - {++}(*protected*){--} - procedure Init; {-}virtual;{+}{++}(*override;*){--} + procedure Init; virtual; public procedure Clear; {* Destoyes all child nodes. } @@ -872,24 +848,18 @@ implementation (------------------------------------------------------------------------------} { TListEx } -//[function NewListEx] function NewListEx: PListEx; begin - {-} new( Result, Create ); - {+}{++}(*Result := PListEx.Create;*){--} Result.fList := NewList; Result.fObjects := NewList; end; -//[END NewListEx] -//[procedure TListEx.Add] procedure TListEx.Add(Value: Pointer); begin AddObj( Value, nil ); end; -//[procedure TListEx.AddObj] procedure TListEx.AddObj(Value, Obj: Pointer); var C: Integer; begin @@ -898,7 +868,6 @@ begin fObjects.Insert( C, Obj ); end; -//[procedure TListEx.Clear] procedure TListEx.Clear; begin fList.Clear; @@ -1020,19 +989,13 @@ type TBitsList = object( TList ) end; - -//[function NewBits] function NewBits: PBits; begin - {-} new( Result, Create ); - {+}{++}(*Result := PBits.Create;*){--} Result.fList := NewList; {$IFDEF TLIST_FAST} Result.fList.UseBlocks:= False; {$ENDIF} - //Result.fList.fAddBy := 1; end; -//[procedure TBits.AssignBits] procedure TBits.AssignBits(ToIdx: Integer; FromBits: PBits; FromIdx, N: Integer); var i: Integer; @@ -2001,24 +1964,21 @@ end; function OpenCABFile( const APaths: array of AnsiString ): PCABFile; var I: Integer; begin - {-} New( Result, Create ); - {+}{++}(*Result := PCABFile.Create;*){--} Result.FSetupapi := LoadLibrary( 'setupapi.dll' ); - Result.FNames := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF}; - Result.FPaths := {$IFDEF UNICODE_CTRLS} NewWStrList {$ELSE} NewStrList {$ENDIF}; + Result.FNames := NewKOLStrList; + Result.FPaths := NewKOLStrList; for I := 0 to High( APaths ) do - Result.FPaths.Add( KOLString(APaths[ I ]) ); + Result.FPaths.Add( KOLString(APaths[ I ]) ); end; -//[destructor TCABFile.Destroy] destructor TCABFile.Destroy; begin FNames.Free; FPaths.Free; FTargetPath := ''; - if FSetupapi <> 0 then - FreeLibrary( FSetupapi ); + if FSetupapi <> 0 then + FreeLibrary( FSetupapi ); inherited; end; @@ -2289,9 +2249,7 @@ function NewDirChangeNotifier( const Path: KOLString; Filter: TFileChangeFilter; : PDirChange; var Flags: DWORD; begin - {-} New( Result, Create ); - {+}{++}(*Result := PDirChange.Create;*){--} Result.FPath := Path; Result.FOnChange := ChangeProc; @@ -2300,16 +2258,16 @@ begin FILE_NOTIFY_CHANGE_ATTRIBUTES or FILE_NOTIFY_CHANGE_SIZE or FILE_NOTIFY_CHANGE_LAST_WRITE else - Flags := MakeFlags( @Filter, FilterFlags ); + Flags := MakeFlags( @Filter, FilterFlags ); Result.FinEvent := CreateEvent( nil, TRUE, FALSE, nil ); Result.FHandle := FindFirstChangeNotification(PKOLChar(Result.FPath), Bool( Integer( WatchSubtree ) ), Flags); - if Result.FHandle <> INVALID_HANDLE_VALUE then - Result.FMonitor := NewThreadAutoFree( Result.Execute ) + if Result.FHandle <> INVALID_HANDLE_VALUE then + Result.FMonitor := NewThreadEx( Result.Execute ) else //MsgOK( 'Can not monitor ' + Result.FPath + #13'Error ' + Int2Str( GetLastError ) ); begin - Result.Free; - Result := nil; + Result.Free; + Result := nil; end; end; {$ENDIF ASM_VERSION} @@ -2337,7 +2295,7 @@ begin end; {$ENDIF ASM_VERSION} -{$IFDEF ASM_VERSION} +{$IFDEF noASM_VERSION} //[destructor TDirChange.Destroy] destructor TDirChange.Destroy; asm @@ -2367,8 +2325,9 @@ begin OnChange := nil; SetEvent( FinEvent ); end; - //if FMonitor <> nil then - // FMonitor.Free; + FMonitor.WaitFor; + FMonitor.Free; + CloseHandle( FinEvent ); FPath := ''; inherited; end; @@ -2417,27 +2376,23 @@ var Handles: array[ 0..1 ] of THandle; begin Handles[ 0 ] := FHandle; Handles[ 1 ] := FinEvent; - while TRUE do - case WaitForMultipleObjects(2, @ Handles[ 0 ], FALSE, INFINITE) of + while not AppletTerminated do + case WaitForMultipleObjects(2, @ Handles[ 0 ], FALSE, 1000) of WAIT_OBJECT_0: begin if AppletTerminated then break; Applet.GetWindowHandle; Sender.Synchronize( Changed ); FindNextChangeNotification(Handles[ 0 ]); - {for i := 1 to 10 do - begin - Sleep( 10 ); - if AppletTerminated then break; - end;} end; + WAIT_TIMEOUT: Sleep( 100 ); else break; end; {$IFDEF SAFE_CODE} TRY {$ENDIF} FindCloseChangeNotification( Handles[ 0 ] ); - CloseHandle( Handles[ 1 ] ); + //CloseHandle( Handles[ 1 ] ); {$IFDEF SAFE_CODE} EXCEPT END; @@ -2454,24 +2409,13 @@ end; // //////////////////////////////////////////////////////////////////////// -{++}(* -//[API SetEnhMetaFileBits] -function SetEnhMetaFileBits; external gdi32 name 'SetEnhMetaFileBits'; -function PlayEnhMetaFile; external gdi32 name 'PlayEnhMetaFile'; -*){--} - -//[function NewMetafile] function NewMetafile: PMetafile; begin - {-} new( Result, Create ); - {+}{++}(*Result := PMetafile.Create;*){--} end; -//[END NewMetafile] { TMetafile } -//[procedure TMetafile.Clear] procedure TMetafile.Clear; begin if fHandle <> 0 then @@ -2479,7 +2423,6 @@ begin fHandle := 0; end; -//[destructor TMetafile.Destroy] destructor TMetafile.Destroy; begin if fHeader <> nil then @@ -2488,39 +2431,32 @@ begin inherited; end; -//[procedure TMetafile.Draw] procedure TMetafile.Draw(DC: HDC; X, Y: Integer); begin StretchDraw( DC, MakeRect( X, Y, X + Width, Y + Height ) ); end; -//[function TMetafile.Empty] function TMetafile.Empty: Boolean; begin Result := fHandle = 0; end; -//[function TMetafile.GetHeight] function TMetafile.GetHeight: Integer; begin Result := 0; if Empty then Exit; RetrieveHeader; Result := fHeader.rclBounds.Bottom - fHeader.rclBounds.Top; - //Result := fHeader.rclFrame.Bottom - fHeader.rclFrame.Top; end; -//[function TMetafile.GetWidth] function TMetafile.GetWidth: Integer; begin Result := 0; if Empty then Exit; RetrieveHeader; Result := fHeader.rclBounds.Right - fHeader.rclBounds.Left; - //Result := fHeader.rclFrame.Right - fHeader.rclFrame.Left; end; -//[function TMetafile.LoadFromFile] function TMetafile.LoadFromFile(const Filename: AnsiString): Boolean; var Strm: PStream; begin @@ -2529,7 +2465,6 @@ begin Strm.Free; end; -//[function ComputeAldusChecksum] function ComputeAldusChecksum(var WMF: TMetafileHeader): Word; type PWord = ^Word; @@ -2547,7 +2482,6 @@ begin end; end; -//[function TMetafile.LoadFromStream] function TMetafile.LoadFromStream(Strm: PStream): Boolean; var WMF: TMetaFileHeader; WmfHdr: TMetaHeader; @@ -2785,7 +2719,7 @@ var c, ss: KOLstring; begin - i:=Pos(#9, Value); + i:= IndexOfChar(Value, #9); //Pos(#9, Value); if i <> 0 then begin c:=Copy(Value, 1, i - 1); ss:=Copy(Value, i + 1, MaxInt); @@ -3393,8 +3327,9 @@ begin AppCtl := Applet; AppletTerminated := FALSE; Title := 'Information'; - if pos( '/', Answers ) > 0 then - Title := 'Question'; + //if pos( '/', Answers ) > 0 then + if IndexOfChar(Answers, '/') > 0 then + Title := 'Question'; {$IFNDEF NO_CHECK_STAYONTOP} DoStayOnTop := FALSE; {$ENDIF NO_CHECK_STAYONTOP} diff --git a/MCKAppExpert200x.pas b/MCKAppExpert200x.pas index b6b383d..e23a672 100644 --- a/MCKAppExpert200x.pas +++ b/MCKAppExpert200x.pas @@ -217,12 +217,14 @@ begin dlg.Options := [ofOverwritePrompt, ofExtensionDifferent, ofPathMustExist]; dlg.Title := 'Save Project'; dlg.Filter := 'DPR files|*.dpr'; + dlg.DefaultExt := 'dpr'; if dlg.Execute then begin prj := dlg.FileName; if (Pos('.', prj) = Length(prj) - 3) then SetLength(prj, Length(prj) - 4); dlg.Title := 'Save Unit'; dlg.Filter := 'PAS files|*.pas'; + dlg.DefaultExt := 'pas'; dlg.FileName := 'unit1'; if dlg.Execute then begin unt := dlg.FileName; diff --git a/MCKfakeClasses.inc b/MCKfakeClasses.inc index 89173fd..b2677a9 100644 --- a/MCKfakeClasses.inc +++ b/MCKfakeClasses.inc @@ -50,6 +50,7 @@ TKOLTreeView = PControl; TKOLToolbar = PControl; TKOLTabControl = PControl; + TKOLTabPage = PControl; TTabPage = PControl; TKOLScrollBox = PControl; TKOLDateTimePicker = PControl; diff --git a/MCKfakeClasses200x.inc b/MCKfakeClasses200x.inc index 53aed52..d24d35e 100644 --- a/MCKfakeClasses200x.inc +++ b/MCKfakeClasses200x.inc @@ -32,6 +32,7 @@ type TKOLTreeView = PControl; TKOLToolbar = PControl; TKOLTabControl = PControl; + TKOLTabPage = PControl; TTabPage = PControl; TKOLScrollBox = PControl; TKOLDateTimePicker = PControl; diff --git a/mckCtrls.pas b/mckCtrls.pas index 5b1a671..1c291ed 100644 --- a/mckCtrls.pas +++ b/mckCtrls.pas @@ -1,11 +1,11 @@ {=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- - - KKKKK KKKKK OOOOOOOOO LLLLL - KKKKK KKKKK OOOOOOOOOOOOO LLLLL - KKKKK KKKKK OOOOO OOOOO LLLLL - KKKKK KKKKK OOOOO OOOOO LLLLL - KKKKKKKKKK OOOOO OOOOO LLLLL - KKKKK KKKKK OOOOO OOOOO LLLLL + tt + KKKKK KKKKK OOOOOOOOO LLLLL ccc tt rr rr + KKKKK KKKKK OOOOOOOOOOOOO LLLLL ccc ccc ttttttttttt rrrr + KKKKK KKKKK OOOOO OOOOO LLLLL ccc tt rr + KKKKK KKKKK OOOOO OOOOO LLLLL ccc tt rr + KKKKKKKKKK OOOOO OOOOO LLLLL ccc ccc tt rr + KKKKK KKKKK OOOOO OOOOO LLLLL ccc ttt rr KKKKK KKKKK OOOOO OOOOO LLLLL KKKKK KKKKK OOOOOOOOOOOOO LLLLLLLLLLLLL kkkkk KKKKK KKKKK OOOOOOOOO LLLLLLLLLLLLL kkkkk @@ -32,7 +32,7 @@ unit mckCtrls; проектирования и ведут себя так же, как обычные визуальные объекты VCL. Но после компиляции проекта (и во время исполнения) они трансформируются в объекты KOL, так что все "навороты" VCL удаляются и исполнимый файл становится - очень маленьким. f + очень маленьким. } interface @@ -67,10 +67,11 @@ type Fimage: TPicture; procedure SetFlat(const Value: Boolean); procedure Setimage(const Value: TPicture); - protected + public function TabStopByDefault: Boolean; override; procedure FirstCreate; override; function GenerateTransparentInits: String; override; + procedure GenerateTransparentInits_Compact; override; function P_GenerateTransparentInits: String; override; function SetupParams( const AName, AParent: TDelphiString): TDelphiString; override; function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; @@ -97,7 +98,7 @@ type procedure SaveImageIcon( Writer: TWriter ); procedure LoadImageBitmap( Reader: TReader ); procedure SaveImageBitmap( Writer: TWriter ); - procedure Loaded; override; + procedure Loaded; override; public constructor Create( AOwner: TComponent ); override; destructor Destroy; override; @@ -125,6 +126,9 @@ type property Flat: Boolean read FFlat write SetFlat; // only for not windowed ? property WordWrap; property LikeSpeedButton; + public + procedure SetupConstruct_Compact; override; + function SupportsFormCompact: Boolean; override; end; //============================================================================ @@ -159,10 +163,11 @@ type procedure SetBitBtnDrawMnemonic(const Value: Boolean); procedure SetTextShiftX(const Value: Integer); procedure SetTextShiftY(const Value: Integer); - protected + public function TabStopByDefault: Boolean; override; procedure FirstCreate; override; function GenerateTransparentInits: String; override; + procedure GenerateTransparentInits_Compact; override; function P_GenerateTransparentInits: String; override; function SetupParams( const AName, AParent: TDelphiString): TDelphiString; override; function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; @@ -183,6 +188,8 @@ type destructor Destroy; override; function Pcode_Generate: Boolean; override; function OptionsAsInteger: Integer; + procedure SetupConstruct_Compact; override; + function SupportsFormCompact: Boolean; override; published property options: TBitBtnOptions read FOptions write SetOptions; property glyphBitmap: TBitmap read FGlyphBitmap write SetGlyphBitmap; @@ -251,7 +258,7 @@ type function Get_VertAlign: TVerticalAlign; procedure Set_VertAlign(const Value: TVerticalAlign); procedure SetShowAccelChar(const Value: Boolean); - protected + public function AdjustVerticalAlign( Value: TVerticalAlign ): TVerticalAlign; virtual; procedure FirstCreate; override; function SetupParams( const AName, AParent: TDelphiString): TDelphiString; override; @@ -273,6 +280,8 @@ type public constructor Create( AOwner: TComponent ); override; function Pcode_Generate: Boolean; override; + procedure SetupConstruct_Compact; override; + function SupportsFormCompact: Boolean; override; published property Transparent; property TextAlign; @@ -295,7 +304,7 @@ type FColor2: TColor; procedure SetShadowDeep(const Value: Integer); procedure SetColor2(const Value: TColor); - protected + public function AdjustVerticalAlign( Value: TVerticalAlign ): TVerticalAlign; override; function SetupParams( const AName, AParent: TDelphiString): TDelphiString; override; function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; @@ -309,6 +318,8 @@ type procedure SetWindowed( const Value: Boolean ); override; public constructor Create( AOwner: TComponent ); override; + procedure SetupConstruct_Compact; override; + function SupportsFormCompact: Boolean; override; published property ShadowDeep: Integer read FShadowDeep write SetShadowDeep; property Color2: TColor read FColor2 write SetColor2; @@ -357,6 +368,7 @@ type procedure P_SetupTextAlign( SL: TStrings; const AName: String ); override; function ClientMargins: TRect; override; function RefName: String; override; + public procedure Paint; override; function WYSIWIGPaintImplemented: Boolean; override; function NoDrawFrame: Boolean; override; @@ -365,6 +377,8 @@ type constructor Create( AOwner: TComponent ); override; destructor Destroy; override; function Pcode_Generate: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published property Transparent; property TextAlign; @@ -421,9 +435,12 @@ type function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure P_SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; + public procedure Paint; override; function WYSIWIGPaintImplemented: Boolean; override; function NoDrawFrame: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; public constructor Create( AOwner: TComponent ); override; function Pcode_Generate: Boolean; override; @@ -467,12 +484,15 @@ type procedure P_SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; function TypeName: String; override; procedure AssignEvents( SL: TStringList; const AName: String ); override; + public function BestEventName: String; override; procedure CreateKOLControl(Recreating: boolean); override; function NoDrawFrame: Boolean; override; public constructor Create( AOwner: TComponent ); override; function Pcode_Generate: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published property Transparent; property MinSizePrev: Integer read FMinSizePrev write SetMinSizePrev; @@ -500,6 +520,7 @@ type function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure P_SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; + public function P_GenerateTransparentInits: String; override; function ClientMargins: TRect; override; function DrawMargins: TRect; override; @@ -507,6 +528,8 @@ type procedure CreateKOLControl(Recreating: boolean); override; {$ENDIF} procedure SetupTextAlign( SL: TStrings; const AName: String ); override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; public constructor Create( AOwner: TComponent ); override; function Pcode_Generate: Boolean; override; @@ -541,12 +564,15 @@ type function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure P_SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; + public function P_GenerateTransparentInits: String; override; procedure Paint; override; function WYSIWIGPaintImplemented: Boolean; override; function NoDrawFrame: Boolean; override; procedure CreateKOLControl(Recreating: boolean); override; function TypeName: String; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; public constructor Create( AOwner: TComponent ); override; function Pcode_Generate: Boolean; override; @@ -587,12 +613,15 @@ type procedure FirstCreate; override; function SetupParams( const AName, AParent: TDelphiString): TDelphiString; override; function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; + public function P_GenerateTransparentInits: String; override; procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure P_SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure Paint; override; function WYSIWIGPaintImplemented: Boolean; override; function NoDrawFrame: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; public constructor Create( AOwner: TComponent ); override; function Pcode_Generate: Boolean; override; @@ -638,11 +667,13 @@ type private FOptions: TKOLEditOptions; FEdTransparent: Boolean; + FUnicode: Boolean; procedure SetOptions(const Value: TKOLEditOptions); function GetCaption: TDelphiString; function GetText: TDelphiString; procedure SetText(const Value: TDelphiString); procedure SetEdTransparent(const Value: Boolean); + procedure SetUnicode(const Value: Boolean); protected function TabStopByDefault: Boolean; override; procedure FirstCreate; override; @@ -650,6 +681,7 @@ type function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure P_SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; + public procedure WantTabs( Want: Boolean ); override; function DefaultColor: TColor; override; function BestEventName: String; override; @@ -663,6 +695,8 @@ type function WYSIWIGPaintImplemented: Boolean; override; function NoDrawFrame: Boolean; override; function Pcode_Generate: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published property Transparent: Boolean read FEdTransparent write SetEdTransparent; property Text: TDelphiString read GetText write SetText; @@ -686,6 +720,7 @@ type property EditTabChar; property Brush; property windowed; + property Unicode: Boolean read FUnicode write SetUnicode; end; @@ -723,6 +758,7 @@ type procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure P_SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; function DefaultColor: TColor; override; + public function BestEventName: String; override; procedure CreateKOLControl(Recreating: boolean); override; procedure KOLControlRecreated; override; @@ -739,6 +775,8 @@ type function TypeName: String; override; procedure WantTabs( Want: Boolean ); override; function Pcode_Generate: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published property Transparent: Boolean read FEdTransparent write SetEdTransparent; property Text: TStrings read GetText write SetText; @@ -822,7 +860,9 @@ type procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure P_SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; function TypeName: String; override; + public function GenerateTransparentInits: String; override; + procedure GenerateTransparentInits_Compact; override; function P_GenerateTransparentInits: String; override; procedure BeforeFontChange( SL: TStrings; const AName, Prefix: String ); override; procedure P_BeforeFontChange( SL: TStrings; const AName, Prefix: String ); override; @@ -838,6 +878,8 @@ type procedure Loaded; override; function NoDrawFrame: Boolean; override; function SetupColorFirst: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; public constructor Create( AOwner: TComponent ); override; destructor Destroy; override; @@ -924,12 +966,16 @@ type procedure SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure P_SetupLast( SL: TStringList; const AName, AParent, Prefix: String ); override; function DefaultColor: TColor; override; + public procedure CreateKOLControl(Recreating: boolean); override; procedure KOLControlRecreated; override; function NoDrawFrame: Boolean; override; procedure Loaded; override; function GenerateTransparentInits: String; override; {+ecm} + procedure GenerateTransparentInits_Compact; override; {+ecm} function P_GenerateTransparentInits: String; override; {+ecm} + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; public constructor Create( AOwner: TComponent ); override; destructor Destroy; override; @@ -995,17 +1041,21 @@ type procedure P_SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; function DefaultColor: TColor; override; function DefaultInitialColor: TColor; override; + public procedure Paint; override; function WYSIWIGPaintImplemented: Boolean; override; function NoDrawFrame: Boolean; override; function AutoHeight( Canvas: graphics.TCanvas ): Integer; override; function AutoSizeRunTime: Boolean; override; function GenerateTransparentInits: String; override; {+ecm} + procedure GenerateTransparentInits_Compact; override; {+ecm} function P_GenerateTransparentInits: String; override; {+ecm} public constructor Create( AOwner: TComponent ); override; destructor Destroy; override; function Pcode_Generate: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published property Transparent; property TabStop; @@ -1045,10 +1095,13 @@ type protected function SetupParams( const AName, AParent: TDelphiString): TDelphiString; override; function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; + public function BestEventName: String; override; public constructor Create( AOwner: TComponent ); override; function Pcode_Generate: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published property Transparent; property OnPaint; @@ -1084,6 +1137,7 @@ type procedure P_SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure DoAutoSize; procedure SetHasBorder(const Value: Boolean); override; + public procedure Paint; override; function WYSIWIGPaintImplemented: Boolean; override; function NoDrawFrame: Boolean; override; @@ -1132,12 +1186,15 @@ type function SetupParams( const AName, AParent: TDelphiString): TDelphiString; override; function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; function TypeName: String; override; + public procedure CreateKOLControl(Recreating: boolean); override; procedure KOLControlRecreated; override; function NoDrawFrame: Boolean; override; public constructor Create( AOwner: TComponent ); override; function Pcode_Generate: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published property Transparent; property Vertical: Boolean read FVertical write SetVertical; @@ -1276,12 +1333,14 @@ type procedure LoadColCount( Reader: TReader ); procedure SaveColCount( Writer: TWriter ); procedure DoGenerateConstants( SL: TStringList ); override; + public procedure Loaded; override; {YS} function NoDrawFrame: Boolean; override; procedure CreateKOLControl(Recreating: boolean); override; procedure KOLControlRecreated; override; function GetDefaultControlFont: HFONT; override; function GenerateTransparentInits: String; override; + procedure GenerateTransparentInits_Compact; override; function P_GenerateTransparentInits: String; override; public ActiveDesign: TfmLVColumnsEditor; @@ -1292,6 +1351,8 @@ type function HasOrderedColumns: Boolean; procedure Invalidate; override; {YS} function Pcode_Generate: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published property Transparent; property Style: TKOLListViewStyle read FStyle write SetStyle; @@ -1299,7 +1360,6 @@ type property ImageListSmall: TKOLImageList read FImageListSmall write SetImageListSmall; property ImageListNormal: TKOLImageList read FImageListNormal write SetImageListNormal; property ImageListState: TKOLImageList read FImageListState write SetImageListState; - //property CurIndex: Integer read FCurIndex write SetCurIndex; property OnChange; property OnKeyDown; property OnKeyUp; @@ -1330,7 +1390,6 @@ type property Columns: String read GetColumns write SetColumns stored FALSE; property generateConstants: Boolean read FGenerateColIdxConst write SetGenerateColIdxConst; property Brush; - property Unicode; {$IFNDEF _D2} //property OnLVDataW: TOnLVDataW read FOnLVDataW write SetOnLVDataW; {$ENDIF _D2} @@ -1387,6 +1446,7 @@ type procedure SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; procedure P_SetupFirst( SL: TStringList; const AName, AParent, Prefix: String ); override; function DefaultColor: TColor; override; + public procedure CreateKOLControl(Recreating: boolean); override; function NoDrawFrame: Boolean; override; public @@ -1394,6 +1454,8 @@ type procedure NotifyLinkedComponent( Sender: TObject; Operation: TNotifyOperation ); override; destructor Destroy; override; function Pcode_Generate: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published property Transparent; property Options: TKOLTreeViewOptions read FOptions write SetOptions; @@ -1423,7 +1485,6 @@ type property OnScroll; property TabStop; property Brush; - property Unicode; property OverrideScrollbars; end; @@ -1557,6 +1618,9 @@ type FTBButtonsWidth: Integer; FgenerateVariables: Boolean; FOnTBCustomDraw: TOnTBCustomDraw; + FCompactCode: Boolean; + FAutosizeButtons: Boolean; + FNoSpaceForImages: Boolean; procedure SetOptions(const Value: TToolbarOptions); procedure Setbitmap(const Value: TBitmap); procedure SetnoTextLabels(const Value: Boolean); @@ -1584,6 +1648,9 @@ type procedure SetTBButtonsWidth(const Value: Integer); procedure SetgenerateVariables(const Value: Boolean); procedure SetOnTBCustomDraw(const Value: TOnTBCustomDraw); + procedure SetCompactCode(const Value: Boolean); + procedure SetAutosizeButtons(const Value: Boolean); + procedure SetNoSpaceForImages(const Value: Boolean); protected FResBmpID: Integer; fNewVersion: Boolean; @@ -1601,6 +1668,7 @@ type procedure WriteNewVersion( Writer: TWriter ); procedure LoadButtonCount( R: TReader ); procedure SaveButtonCount( W: TWriter ); + public procedure Loaded; override; function StandardImagesUsed: Integer; function PicturedButtonsCount: Integer; @@ -1615,8 +1683,13 @@ type procedure Paint; override; function GetDefaultControlFont: HFONT; override; function ImageListsUsed: Boolean; + function ButtonCaptionsList( var Cnt: Integer ): String; + function ButtonImgIndexesList( var Cnt: Integer ): String; public function Generate_SetSize: String; override; + function SupportsFormCompact: Boolean; override; + function HasCompactConstructor: Boolean; override; + procedure SetupConstruct_Compact; override; public ActiveDesign: TfmToolbarEditor; constructor Create( AOwner: TComponent ); override; @@ -1678,6 +1751,10 @@ type // in other case this property can be set to FALSE to make code smaller // and to prevent "heavy" property TRUE from usage. // This property has effect only for toolbars with tboFlat style though. + property CompactCode: Boolean read FCompactCode write SetCompactCode; + property AutosizeButtons: Boolean read FAutosizeButtons write SetAutosizeButtons; + property NoSpaceForImages: Boolean read FNoSpaceForImages write SetNoSpaceForImages; + property Autosize; end; TKOLToolbarButtonsEditor = class( TStringProperty ) @@ -1716,14 +1793,16 @@ type FOnDTPUserString: KOL.TDTParseInputEvent; FOptions: TDateTimePickerOptions; FFormat: String; + FMonthBkColor: TColor; + FMonthTxtColor: TColor; procedure SetOnDTPUserString(const Value: KOL.TDTParseInputEvent); procedure SetOptions(const Value: TDateTimePickerOptions); procedure SetFormat(const Value: String); + procedure SetMonthBkColor(const Value: TColor); + procedure SetMonthTxtColor(const Value: TColor); protected function SetupParams( const AName, AParent: TDelphiString): TDelphiString; override; function P_SetupParams( const AName, AParent: String; var nparams: Integer ): String; override; - function GenerateTransparentInits: String; override; - function P_GenerateTransparentInits: String; override; procedure SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); override; procedure P_SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); override; procedure AssignEvents( SL: TStringList; const AName: String ); override; @@ -1732,6 +1811,8 @@ type public function Pcode_Generate: Boolean; override; constructor Create( AOwner: TComponent ); override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published function TabStopByDefault: Boolean; override; property OnDTPUserString: KOL.TDTParseInputEvent read FOnDTPUserString write SetOnDTPUserString; @@ -1741,6 +1822,8 @@ type property OnDropDown; property OnCloseUp; property OnChange; + property MonthBkColor: TColor read FMonthBkColor write SetMonthBkColor; + property MonthTxtColor: TColor read FMonthTxtColor write SetMonthTxtColor; end; @@ -1748,20 +1831,23 @@ type //=========================================================================== //---- MIRROR FOR A TAB CONTROL //---- ЗЕРКАЛО ДЛЯ ТАБУЛИРОВАННОГО БЛОКНОТА - TKOLTabPage = TKOLPanel; + TKOLTabPage = class(TKOLPanel) + function TypeName: String; override; + end; TKOLTabControl = class( TKOLControl ) private FOptions: TTabControlOptions; FImageList: TKOLImageList; - FTabs: TList; + public FTabs: TList; + protected FImageList1stIdx: Integer; FedgeType: TEdgeStyle; FCurPage: TKOLPanel; FgenerateConstants: Boolean; procedure SetOptions(const Value: TTabControlOptions); procedure SetImageList(const Value: TKOLImageList); - function GetPages(Idx: Integer): TKOLTabPage; + function GetPages(Idx: Integer): TKOLPanel; procedure SetCount(const Value: Integer); function GetCount: Integer; procedure AdjustPages; @@ -1782,17 +1868,22 @@ type procedure SetupLast(SL: TStringList; const AName, AParent, Prefix: String); override; procedure P_SetupLast(SL: TStringList; const AName, AParent, Prefix: String); override; procedure SchematicPaint; + public procedure Paint; override; function WYSIWIGPaintImplemented: Boolean; override; function NoDrawFrame: Boolean; override; - function GetCurrentPage: TKOLTabPage; + function GetCurrentPage: TKOLPanel; procedure DoGenerateConstants( SL: TStringList ); override; public function Pcode_Generate: Boolean; override; constructor Create( AOwner: TComponent ); override; destructor Destroy; override; - property Pages[ Idx: Integer ]: TKOLTabPage read GetPages; + property Pages[ Idx: Integer ]: TKOLPanel read GetPages; procedure SetBounds( aLeft, aTop, aWidth, aHeight: Integer ); override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; + function HasCompactConstructor: Boolean; override; + function IndexOfPage( const page_name: String ): Integer; published property Transparent; property Options: TTabControlOptions read FOptions write SetOptions; @@ -1819,6 +1910,18 @@ type property generateConstants: Boolean read FgenerateConstants write SetgenerateConstants; property OnDrawItem; property Brush; + protected + {fNameSetByReader: String; + fNewTabControl: Boolean; + procedure WhenReaderSetsName(Reader: TReader; Component: TComponent; + var AName: string); + procedure WhenFindComponentClass(Reader: TReader; const CClassName: string; + var CComponentClass: TComponentClass); + procedure ReadNewTabControl(Reader: TReader); + procedure WriteNewTabControl(Writer: TWriter); + procedure DefineProperties(Filer: TFiler); override;} + public + procedure Loaded; override; end; TKOLTabControlEditor = class( TComponentEditor ) @@ -1856,6 +1959,8 @@ type function TypeName: String; override; public function Pcode_Generate: Boolean; override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published constructor Create( AOwner: TComponent ); override; property ScrollBars: TScrollBars read FScrollBars write SetScrollBars; @@ -1905,6 +2010,8 @@ type public function Pcode_Generate: Boolean; override; constructor Create( AOwner: TComponent ); override; + function SupportsFormCompact: Boolean; override; + procedure SetupConstruct_Compact; override; published property popupMenu; property SBMin: Integer read FSBMin write SetSBMin; @@ -1929,7 +2036,7 @@ begin TKOLSplitter, TKOLGradientPanel, TKOLGroupBox, TKOLCheckBox, TKOLRadioBox, TKOLEditBox, TKOLMemo, TKOLRichEdit, TKOLListBox, TKOLComboBox, TKOLPaintBox, TKOLProgressBar, TKOLListView, TKOLTreeView, TKOLToolbar, TKOLTabControl, - TKOLDateTimePicker, TKOLImageShow, TKOLScrollBox, TKOLScrollBar, + TKOLTabPage, TKOLDateTimePicker, TKOLImageShow, TKOLScrollBox, TKOLScrollBar, TKOLMDIClient ] ); RegisterPropertyEditor( TypeInfo( string ), TKOLToolbar, 'buttons', TKOLToolbarButtonsEditor ); @@ -2145,6 +2252,54 @@ begin end; end; +procedure TKOLButton.GenerateTransparentInits_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + if not KF.FormCompact then Exit; + if assigned( FimageIcon ) and not FimageIcon.Empty + {$IFDEF _D2orD3} + {$IFDEF ICON_DIFF_WH} + and (FimageIcon.Width > 0) and (FimageIcon.Height > 0) + {$ELSE} + and (FImageIcon.Size > 0) + {$ENDIF} + {$ENDIF} + then + begin + if + {$IFDEF ICON_DIFF_WH} + (FimageIcon.Width = 32) and (FimageIcon.Height = 32) + {$ELSE} + FImageIcon.Size = 32 + {$ENDIF} + then + begin + KF.FormAddCtlCommand( Name, 'FormSetButtonIcon' ); + KF.FormAddStrParameter( ImageResourceName ); + end + else + begin + KF.FormAddCtlCommand( Name, 'FormSetButtonImage' ); + {$IFDEF ICON_DIFF_WH} + KF.FormAddNumParameter( FImageIcon.Width ); + {$ELSE} + KF.FormAddNumParameter( FImageIcon.Size ); + {$ENDIF} + KF.FormAddNumParameter( FImageIcon.Size ); + KF.FormAddStrParameter( ImageResourceName ); + end; + end + else + if Assigned( FimageBitmap ) and not FimageBitmap.Empty then + begin + KF.FormAddCtlCommand( Name, 'FormSetButtonBitmap' ); + KF.FormAddStrParameter( ImageResourceName ); + end; +end; + function TKOLButton.ImageResourceName: String; begin Result := 'Z' + UpperCase( ParentForm.Name ) + '_' + UpperCase( Name ) + '_IMAGE'; @@ -2492,6 +2647,7 @@ begin if ( csLoading in ComponentState ) then Exit; if Assigned( FImage.Graphic ) and (FImage.Graphic is TBitmap) then begin + Free_And_Nil( FimageIcon ); if FimageBitmap = nil then FImageBitmap := TBitmap.Create; FimageBitmap.Assign( FImage.Bitmap ); @@ -2499,11 +2655,19 @@ begin else if Assigned( FImage.Graphic ) and (FImage.Graphic is TIcon) then begin + FImageBitmap.Free; + FImageBitmap := nil; if FimageIcon = nil then FImageIcon := NewIcon; FImageIcon.Handle := DuplicateIcon( hInstance, FImage.Icon.Handle ); {if FImageIcon.Size = 32 then ShowMessage( 'wayay Setmage:32' );} + end + else + begin + FImageBitmap.Free; + FImageBitmap := nil; + Free_And_Nil( FimageIcon ); end; Change; end; @@ -2521,10 +2685,21 @@ begin inherited; end; +procedure TKOLButton.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewButton', TRUE, TRUE ); + KF.FormAddStrParameter( Caption ); +end; + procedure TKOLButton.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); var Updated: Boolean; TmpIcon: TIcon; + KF: TKOLForm; begin asm jmp @@e_signature @@ -2533,26 +2708,49 @@ begin @@e_signature: end; inherited; - if Flat then - if Windowed then - SL.Add( Prefix + AName + '.Style := ' + AName + '.Style or BS_FLAT;' ) - else - SL.Add( Prefix + AName + '.Flat := TRUE;' ); - if WordWrap and Windowed then - SL.Add( Prefix + AName + '.Style := ' + AName + '.Style or BS_MULTILINE;' ); + KF := ParentKOLForm; + if Flat then + if Windowed then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetStyle' ); + KF.FormAddNumParameter( BS_FLAT ); + end else + SL.Add( Prefix + AName + '.Style := ' + AName + '.Style or BS_FLAT;' ) + else if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetFlat' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.Flat := TRUE;' ); - if assigned( FimageIcon ) and not FimageIcon.Empty - {$IFDEF _D2orD3} + if WordWrap and Windowed then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetStyle' ); + KF.FormAddNumParameter( BS_MULTILINE ); + end else + SL.Add( Prefix + AName + '.Style := ' + AName + '.Style or BS_MULTILINE;' ); + + if assigned( FimageIcon ) and not FimageIcon.Empty + {$IFDEF _D2orD3} {$IFDEF ICON_DIFF_WH} and (Fimageicon.Width > 0) and (Fimageicon.Height > 0) {$ELSE} and (FImageIcon.Size > 0) {$ENDIF} - {$ENDIF} + {$ENDIF} then begin Rpt( 'Button has icon, generate resource', WHITE ); - SL.Add( '{$R ' + ImageResourceName + '.res}' ); + if (KF <> nil) and KF.FormCompact then + begin + (SL as TFormStringList).OnAdd := nil; + SL.Add( '{$R ' + ImageResourceName + '.res}' ); + (SL as TFormStringList).OnAdd := KF.DoFlushFormCompact; + end + else + SL.Add( '{$R ' + ImageResourceName + '.res}' ); TmpIcon := TIcon.Create; TRY TmpIcon.Handle := DuplicateIcon( hInstance, FImageIcon.Handle ); @@ -2562,13 +2760,20 @@ begin TmpIcon.Free; END; end - else - if Assigned( FimageBitmap ) and not FimageBitmap.Empty then + else + if Assigned( FimageBitmap ) and not FimageBitmap.Empty then begin - Rpt( 'Button has bitmap, generate resource', WHITE ); - SL.Add( '{$R ' + ImageResourceName + '.res}' ); - GenerateBitmapResource( FimageBitmap, ImageResourceName, ImageResourceName, - Updated ); + Rpt( 'Button has bitmap, generate resource', WHITE ); + if (KF <> nil) and KF.FormCompact then + begin + (SL as TFormStringList).OnAdd := nil; + SL.Add( '{$R ' + ImageResourceName + '.res}' ); + (SL as TFormStringList).OnAdd := KF.DoFlushFormCompact; + end + else + SL.Add( '{$R ' + ImageResourceName + '.res}' ); + GenerateBitmapResource( FimageBitmap, ImageResourceName, ImageResourceName, + Updated ); end; end; @@ -2624,9 +2829,6 @@ begin Result := AParent + ', ' + C; end; -const TextAligns: array[ TTextAlign ] of String = ( 'taLeft', 'taRight', 'taCenter' ); - VertAligns: array[ TVerticalAlign ] of String = ( 'vaTop', 'vaCenter', 'vaBottom' ); - procedure TKOLButton.SetupTextAlign(SL: TStrings; const AName: String); begin asm @@ -2635,10 +2837,17 @@ begin DB 'TKOLButton.SetupTextAlign', 0 @@e_signature: end; - if TextAlign <> taCenter then - SL.Add( ' ' + AName + '.TextAlign := KOL.' + TextAligns[ TextAlign ] + ';' ); - if VerticalAlign <> vaCenter then - SL.Add( ' ' + AName + '.VerticalAlign := KOL.' + VertAligns[ VerticalAlign ] + ';' ); + + if TextAlign <> taCenter then + GenerateTextAlign( SL, AName ); + + if VerticalAlign <> vaCenter then + GenerateVerticalAlign( SL, AName ); +end; + +function TKOLButton.SupportsFormCompact: Boolean; +begin + Result := TRUE; end; function TKOLButton.TabStopByDefault: Boolean; @@ -2661,8 +2870,6 @@ begin @@e_signature: end; Result := inherited TypeName; - {if wordWrap then - Result := 'WordWrap' + Result;} end; function TKOLButton.WYSIWIGPaintImplemented: Boolean; @@ -2856,8 +3063,19 @@ begin Change; end; +procedure TKOLLabel.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewLabel', TRUE, TRUE ); + KF.FormAddStrParameter( Caption ); +end; + procedure TKOLLabel.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -2866,8 +3084,14 @@ begin @@e_signature: end; inherited; - if ShowAccelChar then - SL.Add( Prefix + AName + '.Style := ' + AName + '.Style and not SS_NOPREFIX;' ); + KF := ParentKOLForm; + if ShowAccelChar then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormResetStyles' ); + KF.FormAddNumParameter( SS_NOPREFIX ); + end else + SL.Add( Prefix + AName + '.Style := ' + AName + '.Style and not SS_NOPREFIX;' ); end; function TKOLLabel.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -2905,10 +3129,11 @@ begin DB 'TKOLLabel.SetupTextAlign', 0 @@e_signature: end; - if TextAlign <> taLeft then - SL.Add( ' ' + AName + '.TextAlign := KOL.' + TextAligns[ TextAlign ] + ';' ); - if VerticalAlign <> vaTop then - SL.Add( ' ' + AName + '.VerticalAlign := KOL.' + VertAligns[ VerticalAlign ] + ';' ); + if TextAlign <> taLeft then + GenerateTextAlign( SL, AName ); + + if VerticalAlign <> vaTop then + GenerateVerticalAlign( SL, AName ); end; procedure TKOLLabel.Set_VertAlign(const Value: TVerticalAlign); @@ -2922,6 +3147,11 @@ begin inherited VerticalAlign := AdjustVerticalAlign( Value ); end; +function TKOLLabel.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLLabel.TypeName: String; begin asm @@ -2931,8 +3161,6 @@ begin @@e_signature: end; Result := inherited TypeName; - {if wordWrap then - Result := 'WordWrap' + Result;} end; function TKOLLabel.WYSIWIGPaintImplemented: Boolean; @@ -3235,14 +3463,23 @@ begin inherited; end; +procedure TKOLPanel.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewPanel', TRUE, TRUE ); + KF.FormAddNumParameter( Integer( EdgeStyle ) ); +end; + procedure TKOLPanel.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); -var +var KF: TKOLForm; + C: String; {$IFDEF _D2009orHigher} - C, C2: WideString; - i : integer; -{$ELSE} - C: string; + C2: WideString; + i : integer; {$ENDIF} begin asm @@ -3255,18 +3492,33 @@ begin if Parent <> nil then if Parent is TKOLTabControl then Exit; // this is not a panel, but a tab page on tab control. - if Caption <> '' then - begin - C := StringConstant('Caption', Caption); - {$IFDEF _D2009orHigher} - C2 := ''; - for i := 2 to Length(C) - 1 do C2 := C2 + '#'+int2str(ord(C[i])); - C := C2; - {$ENDIF} - SL.Add( Prefix + AName + '.Caption := ' + C + ';' ); - end; - if ShowAccelChar then - SL.Add( Prefix + AName + '.Style := ' + AName + '.Style and not SS_NOPREFIX;' ); + KF := ParentKOLForm; + if Caption <> '' then + begin + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetCaption' ); + KF.FormAddStrParameter( Caption ); + end + else + begin + C := StringConstant('Caption', Caption); + {$IFDEF _D2009orHigher} + C2 := ''; + for i := 2 to Length(C) - 1 do C2 := C2 + '#'+int2str(ord(C[i])); + C := C2; + {$ENDIF} + SL.Add( Prefix + AName + '.Caption := ' + C + ';' ); + end; + end; + + if ShowAccelChar then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormResetStyles' ); + KF.FormAddNumParameter( SS_NOPREFIX ); + end else + SL.Add( Prefix + AName + '.Style := ' + AName + '.Style and not SS_NOPREFIX;' ); end; function TKOLPanel.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -3290,10 +3542,11 @@ begin DB 'TKOLPanel.SetupTextAlign', 0 @@e_signature: end; - if TextAlign <> taLeft then - SL.Add( ' ' + AName + '.TextAlign := KOL.' + TextAligns[ TextAlign ] + ';' ); - if VerticalAlign <> vaTop then - SL.Add( ' ' + AName + '.VerticalAlign := KOL.' + VertAligns[ VerticalAlign ] + ';' ); + if TextAlign <> taLeft then + GenerateTextAlign( SL, AName ); + + if VerticalAlign <> vaTop then + GenerateVerticalAlign( SL, AName ); end; procedure TKOLPanel.Set_VA(const Value: TVerticalAlign); @@ -3310,6 +3563,11 @@ begin inherited VerticalAlign := Value; end; +function TKOLPanel.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLPanel.WYSIWIGPaintImplemented: Boolean; begin asm @@ -3487,6 +3745,21 @@ begin Result := Result + '.LikeSpeedButton'; end; +procedure TKOLBitBtn.GenerateTransparentInits_Compact; +var KF: TKOLForm; +begin + if autoAdjustSize then + begin + DefaultWidth := Width; + DefaultHeight := Height; + end; + inherited; + KF := ParentKOLForm; + if (KF = nil) or not KF.FormCompact then Exit; + if LikeSpeedButton then + KF.FormAddCtlCommand( Name, 'TControl.LikeSpeedButton' ); +end; + function TKOLBitBtn.NoDrawFrame: Boolean; begin Result:=HasBorder; @@ -3931,9 +4204,33 @@ begin Change; end; +procedure TKOLBitBtn.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewBitBtn', TRUE, TRUE ); + KF.FormAddStrParameter( Caption ); + KF.FormAddNumParameter( OptionsAsInteger ); + KF.FormAddNumParameter( Integer( GlyphLayout ) ); + if (GlyphBitmap <> nil) and + (GlyphBitmap.Width <> 0) and (GlyphBitmap.Height <> 0) then + begin + KF.FormAddStrParameter( Name + '_BITMAP' ); + KF.FormAddNumParameter( GlyphCount ); + end + else + begin + KF.FormAddStrParameter( '' ); + KF.FormAddNumParameter( 0 ); + end; +end; + procedure TKOLBitBtn.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); var RName: String; + KF: TKOLForm; begin asm jmp @@e_signature @@ -3941,6 +4238,9 @@ begin DB 'TKOLBitBtn.SetupFirst', 0 @@e_signature: end; + + KF := ParentKOLForm; + if ImageList = nil then if Assigned( GlyphBitmap ) and (GlyphBitmap.Width <> 0) and (GlyphBitmap.Height <> 0) then @@ -3949,27 +4249,74 @@ begin Rpt( 'Prepare resource ' + RName + ' (' + UpperCase( Name + '_BITMAP' ) + ')', WHITE ); GenerateBitmapResource( GlyphBitmap, UpperCase( Name + '_BITMAP' ), RName, fUpdated ); + if (KF <> nil) and KF.FormCompact and SupportsFormCompact then + begin + (SL as TFormStringList).OnAdd := nil; + SL.Add( Prefix + '{$R ' + RName + '.res}' ); + (SL as TFormStringList).OnAdd := KF.DoFlushFormCompact; + end else SL.Add( Prefix + '{$R ' + RName + '.res}' ); end; + inherited; - if (Height = DefaultHeight) or autoAdjustSize then - if imageList <> nil then - if ImageIndex >= 0 then - SL.Add( Prefix + AName + '.Height := ' + IntToStr( Height ) + ';' ); - if (Width = DefaultWidth) or autoAdjustSize then - if imageList <> nil then - if ImageIndex >= 0 then - SL.Add( Prefix + AName + '.Width := ' + IntToStr( Width ) + ';' ); - if RepeatInterval > 0 then - SL.Add( Prefix + AName + '.RepeatInterval := ' + IntToStr( RepeatInterval ) + ';' ); - if Flat then - SL.Add( Prefix + AName + '.Flat := TRUE;' ); - if BitBtnDrawMnemonic then - SL.Add( Prefix + AName + '.BitBtnDrawMnemonic := TRUE;' ); - if TextShiftX <> 0 then - SL.Add( Prefix + AName + '.TextShiftX := ' + IntToStr( TextShiftX ) + ';' ); - if TextShiftY <> 0 then - SL.Add( Prefix + AName + '.TextShiftY := ' + IntToStr( TextShiftY ) + ';' ); + if (Height = DefaultHeight) or autoAdjustSize then + if imageList <> nil then + if ImageIndex >= 0 then + if (KF <> nil) and KF.FormCompact and SupportsFormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetHeight' ); + KF.FormAddNumParameter( Height ); + end else + SL.Add( Prefix + AName + '.Height := ' + IntToStr( Height ) + ';' ); + + if (Width = DefaultWidth) or autoAdjustSize then + if imageList <> nil then + if ImageIndex >= 0 then + if (KF <> nil) and KF.FormCompact and SupportsFormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetWidth' ); + KF.FormAddNumParameter( Width ); + end else + SL.Add( Prefix + AName + '.Width := ' + IntToStr( Width ) + ';' ); + + if RepeatInterval > 0 then + if (KF <> nil) and KF.FormCompact and SupportsFormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetRepeatInterval' ); + KF.FormAddNumParameter( RepeatInterval ); + end else + SL.Add( Prefix + AName + '.RepeatInterval := ' + IntToStr( RepeatInterval ) + ';' ); + + if Flat then + if (KF <> nil) and KF.FormCompact and SupportsFormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetFlat' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.Flat := TRUE;' ); + + if BitBtnDrawMnemonic then + if (KF <> nil) and KF.FormCompact and SupportsFormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetBitBtnDrawMnemonic' ); + end else + SL.Add( Prefix + AName + '.BitBtnDrawMnemonic := TRUE;' ); + + if TextShiftX <> 0 then + if (KF <> nil) and KF.FormCompact and SupportsFormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetTextShiftX' ); + KF.FormAddNumParameter( TextShiftX ); + end else + SL.Add( Prefix + AName + '.TextShiftX := ' + IntToStr( TextShiftX ) + ';' ); + + if TextShiftY <> 0 then + if (KF <> nil) and KF.FormCompact and SupportsFormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetTextShiftY' ); + KF.FormAddNumParameter( TextShiftY ); + end else + SL.Add( Prefix + AName + '.TextShiftY := ' + IntToStr( TextShiftY ) + ';' ); end; @@ -4036,10 +4383,17 @@ begin DB 'TKOLBitBtn.SetupTextAlign', 0 @@e_signature: end; - if TextAlign <> taCenter then - SL.Add( ' ' + AName + '.TextAlign := KOL.' + TextAligns[ TextAlign ] + ';' ); - if VerticalAlign <> vaCenter then - SL.Add( ' ' + AName + '.VerticalAlign := KOL.' + VertAligns[ VerticalAlign ] + ';' ); + + if TextAlign <> taCenter then + GenerateTextAlign( SL, AName ); + + if VerticalAlign <> vaCenter then + GenerateVerticalAlign( SL, AName ); +end; + +function TKOLBitBtn.SupportsFormCompact: Boolean; +begin + Result := ImageList = nil; end; function TKOLBitBtn.TabStopByDefault: Boolean; @@ -4396,8 +4750,25 @@ begin Change; end; +procedure TKOLGradientPanel.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNew' + TypeName, TRUE, TRUE ); + KF.FormAddNumParameter( Integer( (Color1 shl 1) or (Color1 shr 31) ) ); + KF.FormAddNumParameter( Integer( (Color2 shl 1) or (Color2 shr 31) ) ); + if TypeName = 'GradientPanelEx' then + begin + KF.FormAddNumParameter( Integer( GradientStyle ) ); + KF.FormAddNumParameter( Integer( GradientLayout ) ); + end; +end; + procedure TKOLGradientPanel.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -4406,12 +4777,31 @@ begin @@e_signature: end; inherited; - if TypeName = 'GradientPanel' then - if GradientStyle >= gsHorizontal then - SL.Add( Prefix + AName + '.GradientStyle := KOL.' + - GradientStyles[ GradientStyle ] + ';' ); - if HasBorder then - SL.Add( Prefix + AName + '.HasBorder := TRUE;' ); + KF := ParentKOLForm; + if TypeName = 'GradientPanel' then + if GradientStyle >= gsHorizontal then + if (KF <> nil) and KF.FormCompact then + begin + if Integer( GradientStyle ) = 1 then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetGradientStyle' ); + // Param = 1 + end + else + begin + KF.FormAddCtlCommand( Name, 'FormSetGradienStyle' ); + KF.FormAddNumParameter( Integer( GradientStyle ) ); + end; + end else + SL.Add( Prefix + AName + '.GradientStyle := KOL.' + + GradientStyles[ GradientStyle ] + ';' ); + if HasBorder then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetHasBorder' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.HasBorder := TRUE;' ); end; function TKOLGradientPanel.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -4429,6 +4819,11 @@ begin GradientLayouts[ GradientLayout ]; end; +function TKOLGradientPanel.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLGradientPanel.TabStopByDefault: Boolean; begin asm @@ -4490,6 +4885,7 @@ begin DefaultMarginRight := 2; MarginRight := 2; DefaultMarginBottom := 2; MarginBottom := 2; FHasBorder := FALSE; FDefHasBorder := FALSE; + AcceptChildren := TRUE; end; {$IFDEF _KOLCtrlWrapper_} {YS} @@ -4569,6 +4965,16 @@ begin ' C2'; end; +procedure TKOLGroupBox.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewGroupBox', TRUE, TRUE ); + KF.FormAddStrParameter( Caption ); +end; + procedure TKOLGroupBox.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); {const @@ -4614,8 +5020,13 @@ end; procedure TKOLGroupBox.SetupTextAlign(SL: TStrings; const AName: String); begin - if TextAlign <> taLeft then - SL.Add( ' ' + AName + '.TextAlign := KOL.' + TextAligns[ TextAlign ] + ';' ); + if TextAlign <> taLeft then + GenerateTextAlign( SL, AName ); +end; + +function TKOLGroupBox.SupportsFormCompact: Boolean; +begin + Result := TRUE; end; function TKOLGroupBox.TabStopByDefault: Boolean; @@ -4706,8 +5117,6 @@ begin if Checked and (action = nil) then //SL.Add( Prefix + AName + '.Checked := TRUE;' ); {P}SL.Add( ' L(1) C1 TControl_.SetChecked<2>'); - {if WordWrap then - SL.Add( Prefix + AName + '.WordWrap := TRUE;' );} end; function TKOLCheckBox.P_SetupParams(const AName, AParent: String; @@ -4760,8 +5169,19 @@ begin Invalidate; end; +procedure TKOLCheckBox.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewCheckBox', TRUE, TRUE ); + KF.FormAddStrParameter( Caption ); +end; + procedure TKOLCheckBox.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -4770,10 +5190,13 @@ begin @@e_signature: end; inherited; - if Checked and (action = nil) then - SL.Add( Prefix + AName + '.Checked := TRUE;' ); - {if WordWrap then - SL.Add( Prefix + AName + '.WordWrap := TRUE;' );} + KF := ParentKOLForm; + if Checked and (action = nil) then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetChecked' ); + end else + SL.Add( Prefix + AName + '.Checked := TRUE;' ); end; function TKOLCheckBox.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -4806,6 +5229,11 @@ begin Result := AParent + ', ' + C; end; +function TKOLCheckBox.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLCheckBox.TabStopByDefault: Boolean; begin asm @@ -4954,14 +5382,34 @@ begin end; end; +procedure TKOLRadioBox.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewRadioBox', TRUE, TRUE ); + KF.FormAddStrParameter( Caption ); +end; + procedure TKOLRadioBox.SetupLast(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin inherited; - if Checked and (action = nil) then + KF := ParentKOLForm; + if Checked and (action = nil) then begin - SL.add( Prefix + AName + '.CreateWindow;' ); - SL.add( Prefix + AName + '.SetRadioChecked;' ); + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.CreateWindow' ); //'FormCreateWindow' ); + KF.FormAddCtlCommand( Name, 'TControl.SetRadioChecked' ); + end + else + begin + SL.add( Prefix + AName + '.CreateWindow;' ); + SL.add( Prefix + AName + '.SetRadioChecked;' ); + end; end; end; @@ -4995,6 +5443,11 @@ begin Result := AParent + ', ' + C; end; +function TKOLRadioBox.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLRadioBox.TabStopByDefault: Boolean; begin asm @@ -5246,15 +5699,35 @@ begin SetCaption( Value ); end; +procedure TKOLEditBox.SetUnicode(const Value: Boolean); +begin + if FUnicode = Value then Exit; + FUnicode := Value; + Change; +end; + function TKOLEditBox.SetupColorFirst: Boolean; begin Result := FALSE; end; +procedure TKOLEditBox.SetupConstruct_Compact; +var KF: TKOLForm; + b: PByte; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewEditBox', TRUE, TRUE ); + b := @ Options; + KF.FormAddNumParameter( b^ ); +end; + procedure TKOLEditBox.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); //const // Aligns: array[ TTextAlign ] of String = ( 'taLeft', 'taRight', 'taCenter' ); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -5263,12 +5736,22 @@ begin @@e_signature: end; inherited; - if Text <> '' then - AddLongTextField( SL, Prefix + AName + '.Text := ', Text, ';', ' + ' ); - //if TextAlign <> taLeft then - // SL.Add( Prefix + AName + '.TextAlign := ' + Aligns[ TextAlign ] + ';' ); - if Transparent then - SL.Add( Prefix + AName + '.Ed_Transparent := TRUE;' ); + KF := ParentKOLForm; + if Text <> '' then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetCaption' ); + KF.FormAddStrParameter( Text ); + end else + AddLongTextField( SL, Prefix + AName + '.Text := ', Text, ';', ' + ' ); + + if Transparent then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.EdSetTransparent' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.Ed_Transparent := TRUE;' ); end; function TKOLEditBox.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -5311,15 +5794,19 @@ end; procedure TKOLEditBox.SetupTextAlign(SL: TStrings; const AName: String); begin inherited; - if TextAlign <> taLeft then - SL.Add(' ' + AName + '.TextAlign := KOL.' + TextAligns[TextAlign] + ';'); - //if Unicode then + if TextAlign <> taLeft then + GenerateTextAlign( SL, AName ); + if Unicode then begin - SL.Add(' {$IFNDEF UNICODE_CTRLS}' + AName + - '.SetUnicode( TRUE );{$ENDIF}' ); + SL.Add(' {$IFNDEF UNICODE_CTRLS}' + AName + '.SetUnicode( TRUE );{$ENDIF}' ); end; end; +function TKOLEditBox.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLEditBox.TabStopByDefault: Boolean; begin asm @@ -5593,11 +6080,46 @@ end; function TKOLMemo.SetupColorFirst: Boolean; begin - Result := FALSE; + Result := FALSE; +end; + +procedure TKOLMemo.SetupConstruct_Compact; +var KF: TKOLForm; + O: TEditOptions; + b: PWord; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewEditBox', TRUE, TRUE ); + O := [eoMultiline]; + if eo_NoHScroll in Options then + O := O + [KOL.eoNoHScroll]; + if eo_NoVScroll in Options then + O := O + [KOL.eoNoVScroll]; + if eo_Lowercase in Options then + O := O + [KOL.eoLowercase]; + if eo_NoHideSel in Options then + O := O + [KOL.eoNoHideSel]; + if eo_OemConvert in Options then + O := O + [KOL.eoOemConvert]; + if eo_Password in Options then + O := O + [KOL.eoPassword]; + if eo_Readonly in Options then + O := O + [KOL.eoReadonly]; + if eo_UpperCase in Options then + O := O + [KOL.eoUpperCase]; + if eo_WantReturn in Options then + O := O + [KOL.eoWantReturn]; + if eo_WantTab in Options then + O := O + [KOL.eoWantTab]; + b := @ O; + KF.FormAddNumParameter( b^ ); end; procedure TKOLMemo.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -5606,12 +6128,22 @@ begin @@e_signature: end; inherited; - //if TextAlign <> taLeft then - // SL.Add( Prefix + AName + '.TextAlign := ' + TextAligns[ TextAlign ] + ';' ); - if FLines.Text <> '' then - AddLongTextField( SL, Prefix + AName + '.Text := ', FLines.Text, ';', ' + ' ); - if Transparent then - SL.Add( Prefix + AName + '.Ed_Transparent := TRUE;' ); + KF := ParentKOLForm; + if FLines.Text <> '' then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetCaption' ); + KF.FormAddStrParameter( FLines.Text ); + end else + AddLongTextField( SL, Prefix + AName + '.Text := ', FLines.Text, ';', ' + ' ); + + if Transparent then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.EdSetTransparent' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.Ed_Transparent := TRUE;' ); end; function TKOLMemo.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -5658,12 +6190,17 @@ end; procedure TKOLMemo.SetupTextAlign(SL: TStrings; const AName: String); begin inherited; - if TextAlign <> taLeft then - SL.Add(' ' + AName + '.TextAlign := KOL.' + TextAligns[TextAlign] + ';'); + if TextAlign <> taLeft then + GenerateTextAlign( SL, AName ); SL.Add(' {$IFNDEF UNICODE_CTRLS}' + AName + '.SetUnicode( TRUE );{$ENDIF}' ); end; +function TKOLMemo.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLMemo.TabStopByDefault: Boolean; begin asm @@ -5777,6 +6314,19 @@ begin end; { /+ecm } +procedure TKOLListBox.GenerateTransparentInits_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + if fLBItemHeight > 0 then + begin + KF.FormAddCtlCommand( Name, 'FormSetLVItemHeight' ); + KF.FormAddNumParameter( fLBItemHeight ); + end; +end; + function TKOLListBox.GetCaption: String; begin asm @@ -5948,14 +6498,27 @@ begin Change; end; +procedure TKOLListBox.SetupConstruct_Compact; +var KF: TKOLForm; + W: PWord; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewListBox', TRUE, TRUE ); + W := @ Options; + KF.FormAddNumParameter( W^ ); +end; + procedure TKOLListBox.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); var {$IFDEF _D2009orHigher} C, C2: WideString; - j : integer; + j : integer; {$ENDIF} - I: Integer; + I: Integer; + KF: TKOLForm; begin asm jmp @@e_signature @@ -5964,28 +6527,50 @@ begin @@e_signature: end; inherited; + KF := ParentKOLForm; if FItems.Text <> '' then begin - for I := 0 to FItems.Count - 1 do - begin - {$IFDEF _D2009orHigher} - C := StringConstant( 'Item' + IntToStr( I ), FItems[ I ] ); - C2 := ''; - for j := 2 to Length(C)-1 do C2 := C2 + '#'+int2str(ord(C[j])); - C := C2; - SL.Add( Prefix + AName + '.Items[ ' + IntToStr( I ) + ' ] := ' + C + ';' ); - {$ELSE} - SL.Add( Prefix + AName + '.Items[ ' + IntToStr( I ) + ' ] := ' + - StringConstant( 'Item' + IntToStr( I ), FItems[ I ] ) + ';' ); - {$ENDIF} - end; + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetListItems' ); + KF.FormAddNumParameter( FItems.Count ); + for I := 0 to FItems.Count-1 do + KF.FormAddStrParameter( FItems[I] ); + end else + for I := 0 to FItems.Count - 1 do + begin + {$IFDEF _D2009orHigher} + C := StringConstant( 'Item' + IntToStr( I ), FItems[ I ] ); + C2 := ''; + for j := 2 to Length(C)-1 do C2 := C2 + '#'+int2str(ord(C[j])); + C := C2; + SL.Add( Prefix + AName + '.Items[ ' + IntToStr( I ) + ' ] := ' + C + ';' ); + {$ELSE} + SL.Add( Prefix + AName + '.Items[ ' + IntToStr( I ) + ' ] := ' + + StringConstant( 'Item' + IntToStr( I ), FItems[ I ] ) + ';' ); + {$ENDIF} + end; end; - if FCurIndex >= 0 then - SL.Add( Prefix + AName + '.CurIndex := ' + IntToStr( FCurIndex ) + ';' ); + if (FCurIndex >= 0) and (Items.Count > 0) then + if (KF <> nil) and KF.FormCompact then + begin + if FCurIndex = 1 then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetCurIdx' ); + // param = 1 + end + else + begin + KF.FormAddCtlCommand( Name, 'FormSetCurIdx' ); + KF.FormAddNumParameter( FCurIndex ); + end; + end else + SL.Add( Prefix + AName + '.CurIndex := ' + IntToStr( FCurIndex ) + ';' ); end; procedure TKOLListBox.SetupLast(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -5994,9 +6579,23 @@ begin @@e_signature: end; inherited; - if loNoData in Options then - if Count > 0 then - SL.Add( Prefix + AName + '.Count := ' + IntToStr( Count ) + ';' ); + KF := ParentKOLForm; + if loNoData in Options then + if Count > 0 then + if (KF <> nil) and KF.FormCompact then + begin + if Count = 1 then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetItemsCount' ); + // param = 1 + end + else + begin + KF.FormAddCtlCommand( Name, 'FormSetCount' ); + KF.FormAddNumParameter( Count ); + end; + end else + SL.Add( Prefix + AName + '.Count := ' + IntToStr( Count ) + ';' ); end; function TKOLListBox.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -6040,6 +6639,11 @@ begin Result := AParent + ', [ ' + S + ' ]'; end; +function TKOLListBox.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLListBox.TabStopByDefault: Boolean; begin asm @@ -6155,6 +6759,20 @@ begin Result := Result + inherited GenerateTransparentInits(); end; +procedure TKOLComboBox.GenerateTransparentInits_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + if not KF.FormCompact then Exit; + if fCBItemHeight > 0 then + begin + KF.FormAddCtlCommand( Name, 'FormSetLVItemHeight' ); + KF.FormAddNumParameter( fCBItemHeight ); + end; +end; + function TKOLComboBox.NoDrawFrame: Boolean; begin Result := HasBorder; @@ -6287,6 +6905,18 @@ begin Invalidate; end; +procedure TKOLComboBox.SetupConstruct_Compact; +var KF: TKOLForm; + W: PWord; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewComboBox', TRUE, TRUE ); + W := @ Options; + KF.FormAddNumParameter( W^ ); +end; + procedure TKOLComboBox.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); var @@ -6295,6 +6925,7 @@ var j : integer; {$ENDIF} I: Integer; + KF: TKOLForm; begin asm jmp @@e_signature @@ -6303,26 +6934,54 @@ begin @@e_signature: end; inherited; + KF := ParentKOLForm; if FItems.Text <> '' then begin - for I := 0 to FItems.Count - 1 do - begin - {$IFDEF _D2009orHigher} - C := StringConstant( 'Item' + IntToStr( I ), FItems[ I ] ); - C2 := ''; - for j := 2 to Length(C)-1 do C2 := C2 + '#'+int2str(ord(C[j])); - C := C2; - SL.Add( Prefix + AName + '.Items[ ' + IntToStr( I ) + ' ] := ' + C + ';' ); - {$ELSE} - SL.Add( Prefix + AName + '.Items[ ' + IntToStr( I ) + ' ] := ' + - StringConstant( 'Item' + IntToStr( I ), FItems[ I ] ) + ';' ); - {$ENDIF} - end; + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetListItems' ); + KF.FormAddNumParameter( FItems.Count ); + for I := 0 to FItems.Count-1 do + KF.FormAddStrParameter( FItems[I] ); + end else + for I := 0 to FItems.Count - 1 do + begin + {$IFDEF _D2009orHigher} + C := StringConstant( 'Item' + IntToStr( I ), FItems[ I ] ); + C2 := ''; + for j := 2 to Length(C)-1 do C2 := C2 + '#'+int2str(ord(C[j])); + C := C2; + SL.Add( Prefix + AName + '.Items[ ' + IntToStr( I ) + ' ] := ' + C + ';' ); + {$ELSE} + SL.Add( Prefix + AName + '.Items[ ' + IntToStr( I ) + ' ] := ' + + StringConstant( 'Item' + IntToStr( I ), FItems[ I ] ) + ';' ); + {$ENDIF} + end; end; - if FCurIndex >= 0 then - SL.Add( Prefix + AName + '.CurIndex := ' + IntToStr( FCurIndex ) + ';' ); - if (FDroppedWidth <> Width) and (FDroppedWidth <> 0) then - SL.Add( Prefix + AName + '.DroppedWidth := ' + IntToStr( FDroppedWidth ) + ';' ); + + if (FCurIndex >= 0) and (Items.Count > 0) then + if (KF <> nil) and KF.FormCompact then + begin + if FCurIndex = 1 then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetCurIdx' ); + // param = 1 + end + else + begin + KF.FormAddCtlCommand( Name, 'FormSetCurIdx' ); + KF.FormAddNumParameter( FCurIndex ); + end; + end else + SL.Add( Prefix + AName + '.CurIndex := ' + IntToStr( FCurIndex ) + ';' ); + + if (FDroppedWidth <> Width) and (FDroppedWidth <> 0) then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetDroppedWidth' ); + KF.FormAddNumParameter( FDroppedWidth ); + end else + SL.Add( Prefix + AName + '.DroppedWidth := ' + IntToStr( FDroppedWidth ) + ';' ); end; function TKOLComboBox.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -6362,6 +7021,11 @@ begin Result := AParent + ', [ ' + S + ' ]'; end; +function TKOLComboBox.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLComboBox.TabStopByDefault: Boolean; begin asm @@ -6542,6 +7206,17 @@ begin Change; end; +procedure TKOLSplitter.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewSplitter', TRUE, TRUE ); + KF.FormAddNumParameter( Integer( MinSizePrev ) ); + KF.FormAddNumParameter( Integer( MinSizeNext ) ); +end; + procedure TKOLSplitter.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); begin @@ -6569,6 +7244,11 @@ begin Result := Result + ', ' + Styles[ EdgeStyle ]; end; +function TKOLSplitter.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLSplitter.TypeName: String; begin asm @@ -6621,6 +7301,15 @@ begin Result := ' DUP'; end; +procedure TKOLPaintBox.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewPaintBox', TRUE, TRUE ); +end; + function TKOLPaintBox.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; begin asm @@ -6632,6 +7321,11 @@ begin Result := AParent; end; +function TKOLPaintBox.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + { TKOLListView } procedure TKOLListView.AssignEvents(SL: TStringList; const AName: String); @@ -6979,8 +7673,8 @@ procedure TKOLListView.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); var I: Integer; Col: TKOLListViewColumn; + KF: TKOLForm; W: Integer; - WifUnicode: String; {$IFDEF _D2009orHigher} C, C2: WideString; j : integer; @@ -6993,57 +7687,116 @@ begin @@e_signature: end; inherited; - if Unicode then WifUnicode := 'W' else WifUnicode := ''; - if (Font.Color <> clWindowText) and (Font.Color <> clNone) and (Font.Color <> clDefault) then - SL.Add( Prefix + AName + '.LVTextColor := ' + Color2Str( Font.Color ) + ';' ); - if (LVTextBkColor <> clDefault) and (LVTextBkColor <> clNone) and (LVTextBkColor <> clWindow) then - SL.Add( Prefix + AName + '.LVTextBkColor := ' + Color2Str( LVTextBkColor ) + ';' ); - if (LVBkColor <> clDefault) and (LVBkColor <> clNone) and (LVBkColor <> clWindow) then - SL.Add( Prefix + AName + '.LVBkColor := ' + Color2Str( LVBkColor ) + ';' ); - for I := 0 to Cols.Count-1 do - begin - Col := Cols[ I ]; - W := Col.Width; - if Col.FLVColRightImg then - W := -W; - {$IFDEF _D2009orHigher} - C := StringConstant( 'Column' + IntToStr( I ) + 'Caption', Col.Caption ); - if C <> '''''' then + KF := ParentKOLForm; + if (Font.Color <> clWindowText) and (Font.Color <> clNone) and (Font.Color <> clDefault) then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetLVTextColor' ); + KF.FormAddNumParameter( (Font.Color shl 1) or (Font.Color shr 31) ); + end else + SL.Add( Prefix + AName + '.LVTextColor := ' + Color2Str( Font.Color ) + ';' ); + + if (LVTextBkColor <> clDefault) and (LVTextBkColor <> clNone) and (LVTextBkColor <> clWindow) then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetLVTextBkColor' ); + KF.FormAddNumParameter( (LVTextBkColor shl 1) or (LVTextBkColor shr 31) ); + end else + SL.Add( Prefix + AName + '.LVTextBkColor := ' + Color2Str( LVTextBkColor ) + ';' ); + + if (LVBkColor <> clDefault) and (LVBkColor <> clNone) and (LVBkColor <> clWindow) then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetLVBkColor' ); + KF.FormAddNumParameter( (LVBkColor shl 1) or (LVBkColor shr 31) ); + end else + SL.Add( Prefix + AName + '.LVBkColor := ' + Color2Str( LVBkColor ) + ';' ); + + if (KF <> nil) and KF.FormCompact and (Cols.Count > 0) then + begin + KF.FormAddCtlCommand( Name, 'FormLVColumsAdd' ); + KF.FormAddNumParameter( Cols.Count ); + for I := 0 to Cols.Count-1 do begin - C2 := ''; - for j := 2 to Length(C)-1 do C2 := C2 + '#'+int2str(ord(C[j])); - C := C2; + Col := Cols[ I ]; + W := Col.Width; + if Col.FLVColRightImg then + W := -W; + KF.FormAddNumParameter( W ); + KF.FormAddStrParameter( Col.Caption ); end; - SL.Add( Prefix + AName + '.LVColAdd' + WifUnicode + '( ' + - C + ', ' + - TextAligns[ Col.TextAlign ] + ', ' + IntToStr( W ) + ');' ); - {$ELSE} - SL.Add( Prefix + AName + '.LVColAdd' + WifUnicode + '( ' + - StringConstant( 'Column' + IntToStr( I ) + 'Caption', - Col.Caption ) + ', ' + - TextAligns[ Col.TextAlign ] + ', ' + IntToStr( W ) + ');' ); - {$ENDIF} - if Col.LVColImage >= 0 then - SL.Add( Prefix + AName + '.LVColImage[ ' + IntToStr( I ) + ' ] := ' + - IntToStr( Col.LVColImage ) + ';' ); - end; - for I := 0 to Cols.Count-1 do - begin - Col := Cols[ I ]; - if Col.LVColOrder >= 0 then - if Col.LVColOrder <> I then - SL.Add( Prefix + AName + '.LVColOrder[ ' + IntToStr( I ) + ' ] := ' + - IntToStr( Col.LVColOrder ) + ';' ); - end; - //+++++++++++++++++++++++++++++ 2.93 - if (lvoEditLabel in Options) and not Assigned( OnEndEditLVItem ) then - begin - SL.Add( Prefix + AName + '.OnEndEditLVItem := nil;' ); - end; + for I := 0 to Cols.Count-1 do + begin + Col := Cols[ I ]; + if Col.LVColImage >= 0 then + begin + KF.FormAddCtlCommand( Name, 'FormSetLVColImage' ); + KF.FormAddNumParameter( I ); + KF.FormAddNumParameter( Col.LVColImage ); + end; + if Col.LVColOrder >= 0 then + if Col.LVColOrder <> I then + begin + KF.FormAddCtlCommand( Name, 'FormSetLVColOrder' ); + KF.FormAddNumParameter( I ); + KF.FormAddNumParameter( Col.LVColOrder ); + end; + end; + end + else + begin + for I := 0 to Cols.Count-1 do + begin + Col := Cols[ I ]; + W := Col.Width; + if Col.FLVColRightImg then + W := -W; + begin + {$IFDEF _D2009orHigher} + C := StringConstant( 'Column' + IntToStr( I ) + 'Caption', Col.Caption ); + if C <> '''''' then + begin + C2 := ''; + for j := 2 to Length(C)-1 do + C2 := C2 + '#'+int2str(ord(C[j])); + C := C2; + end; + SL.Add( Prefix + AName + '.LVColAdd( ' + + C + ', ' + + TextAligns[ Col.TextAlign ] + ', ' + IntToStr( W ) + ');' ); + {$ELSE} + SL.Add( Prefix + AName + '.LVColAdd' + '( ' + + StringConstant( 'Column' + IntToStr( I ) + 'Caption', + Col.Caption ) + ', ' + + TextAligns[ Col.TextAlign ] + ', ' + IntToStr( W ) + ');' ); + {$ENDIF} + if Col.LVColImage >= 0 then + SL.Add( Prefix + AName + '.LVColImage[ ' + IntToStr( I ) + ' ] := ' + + IntToStr( Col.LVColImage ) + ';' ); + end; + end; + for I := 0 to Cols.Count-1 do + begin + Col := Cols[ I ]; + if Col.LVColOrder >= 0 then + if Col.LVColOrder <> I then + SL.Add( Prefix + AName + '.LVColOrder[ ' + IntToStr( I ) + ' ] := ' + + IntToStr( Col.LVColOrder ) + ';' ); + end; + //+++++++++++++++++++++++++++++ 2.93 + end; + if (lvoEditLabel in Options) and not Assigned( OnEndEditLVItem ) then + begin + (SL as TFormStringList).OnAdd := nil; + SL.Add( Prefix + AName + '.OnEndEditLVItem := nil;' ); + if KF <> nil then + (SL as TFormStringList).OnAdd := KF.DoFlushFormCompact; + end; end; procedure TKOLListView.SetupLast(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -7052,8 +7805,14 @@ begin @@e_signature: end; inherited; - if LVCount > 0 then - SL.Add( Prefix + AName + '.LVCount := ' + IntToStr( LVCount ) + ';' ); + KF := ParentKOLForm; + if LVCount > 0 then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetCount' ); + KF.FormAddNumParameter( LVCount ); + end else + SL.Add( Prefix + AName + '.LVCount := ' + IntToStr( LVCount ) + ';' ); end; function TKOLListView.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -7273,6 +8032,7 @@ procedure TKOLListView.P_SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); var I: Integer; Col: TKOLListViewColumn; + KF: TKOLForm; W: Integer; WifUnicode: String; begin @@ -7283,7 +8043,8 @@ begin @@e_signature: end; inherited; - if Unicode then WifUnicode := 'W' else WifUnicode := ''; + KF := ParentKOLForm; + if (KF <> nil) and KF.Unicode then WifUnicode := 'W' else WifUnicode := ''; if (Font.Color <> clWindowText) and (Font.Color <> clNone) and (Font.Color <> clDefault) then //SL.Add( Prefix + AName + '.LVTextColor := ' + Color2Str( Font.Color ) + ';' ); {P}SL.Add( ' L($' + IntToHex( Font.Color, 6 ) + ')' + @@ -7483,6 +8244,28 @@ begin [ TRUE, TRUE ], CheckOnly ); end; +procedure TKOLListView.GenerateTransparentInits_Compact; +begin + inherited; + +end; + +procedure TKOLListView.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewListView', TRUE, TRUE ); + KF.FormAddNumParameter( Integer( Style ) ); + KF.FormAddNumParameter( PInteger( @ Options )^ ); +end; + +function TKOLListView.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + { TKOLTreeView } constructor TKOLTreeView.Create(AOwner: TComponent); @@ -7733,8 +8516,19 @@ begin Change; end; +procedure TKOLTreeView.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewTreeView', TRUE, TRUE ); + KF.FormAddNumParameter( PInteger( @ Options )^ ); +end; + procedure TKOLTreeView.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -7743,10 +8537,22 @@ begin @@e_signature: end; inherited; - if TVRightClickSelect then - SL.Add( Prefix + AName + '.TVRightClickSelect := TRUE;' ); - if TVIndent > 0 then - SL.Add( Prefix + AName + '.TVIndent := ' + IntToStr( TVIndent ) + ';' ); + KF := ParentKOLForm; + if TVRightClickSelect then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TKOLControl.SetTVRightClickSelect' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.TVRightClickSelect := TRUE;' ); + + if TVIndent > 0 then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetTVIndent' ); + KF.FormAddNumParameter( TVIndent ); + end else + SL.Add( Prefix + AName + '.TVIndent := ' + IntToStr( TVIndent ) + ';' ); end; function TKOLTreeView.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -7809,6 +8615,11 @@ begin Result := AParent + ', [ ' + O + ' ], ' + ILNr + ', ' + ILSt; end; +function TKOLTreeView.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLTreeView.TabStopByDefault: Boolean; begin asm @@ -7894,7 +8705,7 @@ begin Include(opts, kol.eoNoVScroll); if eo_UpperCase in FOptions then Include(opts, kol.eoUpperCase); - FKOLCtrl:=NewRichEdit(KOLParentCtrl, opts); + FKOLCtrl := NewRichEdit(KOLParentCtrl, opts); LogOK; FINALLY Log( '<-TKOLRichEdit.CreateKOLControl' ); @@ -7960,6 +8771,16 @@ begin Result := Result + '.RE_FmtStandard'; end; +procedure TKOLRichEdit.GenerateTransparentInits_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + if RE_FmtStandard then + KF.FormAddCtlCommand( Name, 'TControl.RE_FmtStandard' ); +end; + function TKOLRichEdit.GetCaption: String; begin asm @@ -8315,10 +9136,45 @@ begin Result := FALSE; end; +procedure TKOLRichEdit.SetupConstruct_Compact; +var KF: TKOLForm; + O: TEditOptions; + b: PWord; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewRichEdit', TRUE, TRUE ); + O := [eoMultiline]; + if eo_NoHScroll in Options then + O := O + [KOL.eoNoHScroll]; + if eo_NoVScroll in Options then + O := O + [KOL.eoNoVScroll]; + if eo_Lowercase in Options then + O := O + [KOL.eoLowercase]; + if eo_NoHideSel in Options then + O := O + [KOL.eoNoHideSel]; + if eo_OemConvert in Options then + O := O + [KOL.eoOemConvert]; + if eo_Password in Options then + O := O + [KOL.eoPassword]; + if eo_Readonly in Options then + O := O + [KOL.eoReadonly]; + if eo_UpperCase in Options then + O := O + [KOL.eoUpperCase]; + if eo_WantReturn in Options then + O := O + [KOL.eoWantReturn]; + if eo_WantTab in Options then + O := O + [KOL.eoWantTab]; + b := @ O; + KF.FormAddNumParameter( b^ ); +end; + procedure TKOLRichEdit.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); const BoolVal: array[ Boolean ] of String = ( 'FALSE', 'TRUE' ); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -8327,36 +9183,107 @@ begin @@e_signature: end; inherited; - if RE_AutoURLDetect then - SL.Add( Prefix + AName + '.RE_AutoURLDetect := TRUE;' ); - if not RE_AutoFont then - SL.Add( Prefix + AName + '.RE_AutoFont := FALSE;' ); - if not RE_AutoFontSizeAdjust then - SL.Add( Prefix + AName + '.RE_AutoFontSizeAdjust := FALSE;' ); - if RE_DualFont then - SL.Add( Prefix + AName + '.RE_DualFont := TRUE;' ); - if RE_UIFonts then - SL.Add( Prefix + AName + '.RE_UIFonts := TRUE;' ); - if RE_IMECancelComplete then - SL.Add( Prefix + AName + '.RE_IMECancelComplete := TRUE;' ); - if RE_IMEAlwaysSendNotify then - SL.Add( Prefix + AName + '.RE_IMEAlwaysSendNotify := TRUE;' ); - if MaxTextSize <> 32767 then - if MaxTextSize > $7FFFffff then - SL.Add( Prefix + AName + '.MaxTextSize := $' + Int2Hex( MaxTextSize, 8 ) + ';' ) - else - SL.Add( Prefix + AName + '.MaxTextSize := ' + IntToStr( MaxTextSize ) + ';' ); - if FLines.Text <> '' then - AddLongTextField( SL, Prefix + AName + '.Text := ', FLines.Text, ';', ' + ' ); - if RE_AutoKeybdSet then - SL.Add( Prefix + AName + '.RE_AutoKeyboard := ' + BoolVal[ RE_AutoKeyboard ] + ';' ); - if RE_DisableOverwriteChange then - SL.Add( Prefix + AName + '.RE_DisableOverwriteChange := TRUE;' ); - if RE_Transparent then - SL.Add( Prefix + AName + '.RE_Transparent := TRUE;' ); - if (FRE_ZoomNumerator <> 0) and (FRE_ZoomDenominator <> 0) then - SL.Add( Prefix + AName + '.RE_Zoom := MakeSmallPoint( ' + IntToStr( FRE_ZoomNumerator ) + - ', ' + IntToStr( FRE_ZoomDenominator ) + ' );' ); + KF := ParentKOLForm; + if RE_AutoURLDetect then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.RESetAutoURLDetect' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.RE_AutoURLDetect := TRUE;' ); + + if not RE_AutoFont then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetRE_AutoFontFalse' ); + end else + SL.Add( Prefix + AName + '.RE_AutoFont := FALSE;' ); + + if not RE_AutoFontSizeAdjust then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetRE_AutoFontSizeAdjustFalse' ); + end else + SL.Add( Prefix + AName + '.RE_AutoFontSizeAdjust := FALSE;' ); + + if RE_DualFont then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetRE_DualFontTrue' ); + end else + SL.Add( Prefix + AName + '.RE_DualFont := TRUE;' ); + + if RE_UIFonts then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetRE_UIFontsTrue' ); + end else + SL.Add( Prefix + AName + '.RE_UIFonts := TRUE;' ); + + if RE_IMECancelComplete then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetRE_IMECancelCompleteTrue' ); + end else + SL.Add( Prefix + AName + '.RE_IMECancelComplete := TRUE;' ); + + if RE_IMEAlwaysSendNotify then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetRE_IMEAlwaysSendNotifyTrue' ); + end else + SL.Add( Prefix + AName + '.RE_IMEAlwaysSendNotify := TRUE;' ); + + if MaxTextSize <> 32767 then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetMaxTextSize' ); + KF.FormAddNumParameter( MaxTextSize ); + end else + if MaxTextSize > $7FFFffff then + SL.Add( Prefix + AName + '.MaxTextSize := $' + Int2Hex( MaxTextSize, 8 ) + ';' ) + else + SL.Add( Prefix + AName + '.MaxTextSize := ' + IntToStr( MaxTextSize ) + ';' ); + + if FLines.Text <> '' then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetCaption' ); + KF.FormAddStrParameter( FLines.Text ); + end else + AddLongTextField( SL, Prefix + AName + '.Text := ', FLines.Text, ';', ' + ' ); + + if RE_AutoKeybdSet then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetRE_AutoKeyboardTrue' ); + end else + SL.Add( Prefix + AName + '.RE_AutoKeyboard := ' + BoolVal[ RE_AutoKeyboard ] + ';' ); + + if RE_DisableOverwriteChange then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetRE_DisableOverwriteChangeTrue' ); + end else + SL.Add( Prefix + AName + '.RE_DisableOverwriteChange := TRUE;' ); + + if RE_Transparent then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.ReSetTransparent' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.RE_Transparent := TRUE;' ); + + if (FRE_ZoomNumerator <> 0) and (FRE_ZoomDenominator <> 0) then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetRe_Zoom' ); + KF.FormAddNumParameter( FRE_ZoomNumerator ); + KF.FormAddNumParameter( FRE_ZoomDenominator ); + end else + SL.Add( Prefix + AName + '.RE_Zoom := MakeSmallPoint( ' + IntToStr( FRE_ZoomNumerator ) + + ', ' + IntToStr( FRE_ZoomDenominator ) + ' );' ); end; function TKOLRichEdit.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -8407,6 +9334,11 @@ begin Change; end; +function TKOLRichEdit.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLRichEdit.TabStopByDefault: Boolean; begin asm @@ -8640,8 +9572,23 @@ begin Change; end; +procedure TKOLProgressBar.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + if Smooth or Vertical then + begin + KF.FormAddAlphabet( 'FormNewProgressBarEx', TRUE, TRUE ); + KF.FormAddNumParameter( Integer(Smooth) or Integer(Vertical) shl 1 ); + end else + KF.FormAddAlphabet( 'FormNewProgressBar', TRUE, TRUE ); +end; + procedure TKOLProgressBar.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -8650,14 +9597,30 @@ begin @@e_signature: end; inherited; - if MaxProgress <> 100 then - SL.Add( Prefix + AName + '.MaxProgress := ' + IntToStr( MaxProgress ) + ';' ); - if Progress <> 0 then - SL.Add( Prefix + AName + '.Progress := ' + IntToStr( Progress ) + ';' ); - if ProgressColor <> clHighLight then - SL.Add( Prefix + AName + '.ProgressColor := ' + Color2Str( ProgressColor ) + ';' ); - {if ProgressBkColor <> clBtnFace then - SL.Add( Prefix + AName + '.ProgressBkColor := ' + Color2Str( ProgressBkColor ) + ';' );} + KF := ParentKOLForm; + if MaxProgress <> 100 then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetMaxProgress' ); + KF.FormAddNumParameter( MaxProgress ); + end else + SL.Add( Prefix + AName + '.MaxProgress := ' + IntToStr( MaxProgress ) + ';' ); + + if Progress <> 0 then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetProgress' ); + KF.FormAddNumParameter( Progress ); + end else + SL.Add( Prefix + AName + '.Progress := ' + IntToStr( Progress ) + ';' ); + + if ProgressColor <> clHighLight then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetProgressColor' ); + KF.FormAddNumParameter( (ProgressColor shl 1) or (ProgressColor shr 31) ); + end else + SL.Add( Prefix + AName + '.ProgressColor := ' + Color2Str( ProgressColor ) + ';' ); end; function TKOLProgressBar.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -8698,6 +9661,11 @@ begin Change; end; +function TKOLProgressBar.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLProgressBar.TypeName: String; begin asm @@ -8790,6 +9758,25 @@ begin FgenerateConstants := TRUE; end; +{procedure TKOLTabControl.DefineProperties(Filer: TFiler); +begin + Beep; + inherited; + ShowMessage( 'TabControl DefineProperties called' ); + LogFileOutput( 'C:\log_TC.txt', 'TabControl DefineProperties called' ); + Filer.DefineProperty( 'NewTabControl', ReadNewTabControl, WriteNewTabControl, + fNewTabControl ); + if Filer is TReader then + begin + (Filer as TReader).OnSetName := WhenReaderSetsName; + (Filer as TReader).OnFindComponentClass := WhenFindComponentClass; + ShowMessage( 'Filter set for TKOLTabControl!' ); + LogFileOutput( 'C:\log_TC.txt', 'Filter set' ); + end; + ShowMessage( 'DefineProperties inherited called' ); + LogFileOutput( 'C:\log_TC.txt', 'inherited DefineProperties called' ); +end;} + destructor TKOLTabControl.Destroy; var I: Integer; begin @@ -8807,7 +9794,7 @@ begin end; function CompareTabPages( L: TList; e1, e2: DWORD ): Integer; -var P1, P2: TKOLTabPage; +var P1, P2: TKOLPanel; begin asm jmp @@e_signature @@ -8841,7 +9828,7 @@ end; procedure TKOLTabControl.DoGenerateConstants(SL: TStringList); var I: Integer; C: TComponent; - K: TKOLTabPage; + K: TKOLPanel; Pages: TList; F: TForm; begin @@ -8854,8 +9841,8 @@ begin for I := 0 to F.ComponentCount-1 do begin C := F.Components[ I ]; - if not ( C is TKOLTabPage ) then CONTINUE; - K := C as TKOLTabPage; + if not ( C is TKOLPanel ) then CONTINUE; + K := C as TKOLPanel; if K.Parent <> Self then CONTINUE; Pages.Add( K ); end; @@ -8873,7 +9860,7 @@ end; function TKOLTabControl.GetCount: Integer; var I: Integer; C: TComponent; - K: TKOLTabPage; + K: TKOLPanel; F: TForm; begin asm @@ -8889,8 +9876,8 @@ begin for I := 0 to F.ComponentCount-1 do begin C := F.Components[ I ]; - if not ( C is TKOLTabPage ) then CONTINUE; - K := C as TKOLTabPage; + if not ( C is TKOLPanel ) then CONTINUE; + K := C as TKOLPanel; if K.Parent <> Self then CONTINUE; Inc( Result ); end; @@ -8898,7 +9885,7 @@ end; function TKOLTabControl.GetCurIndex: Integer; var I: Integer; - CurPage: TKOLTabPage; + CurPage: TKOLPanel; begin asm jmp @@e_signature @@ -8917,7 +9904,7 @@ begin end; end; -function TKOLTabControl.GetCurrentPage: TKOLTabPage; +function TKOLTabControl.GetCurrentPage: TKOLPanel; var W: HWnd; C: TWinControl; begin @@ -8933,24 +9920,18 @@ begin W := GetWindow( Handle, GW_CHILD ); if W = 0 then Exit; C := FindControl( W ); - if C is TKOLTabPage then + if C is TKOLPanel then begin - Result := C as TKOLTabPage; + Result := C as TKOLPanel; FCurPage:=Result; end; end; - {Result := nil; - W := GetWindow( Handle, GW_CHILD ); - if W = 0 then Exit; - C := FindControl( W ); - if C is TKOLTabPage then - Result := C as TKOLTabPage;} end; -function TKOLTabControl.GetPages(Idx: Integer): TKOLTabPage; +function TKOLTabControl.GetPages(Idx: Integer): TKOLPanel; var I: Integer; C: TComponent; - K: TKOLTabPage; + K: TKOLPanel; F: TForm; L: TList; begin @@ -8969,8 +9950,8 @@ begin for I := 0 to F.ComponentCount-1 do begin C := F.Components[ I ]; - if not ( C is TKOLTabPage ) then CONTINUE; - K := C as TKOLTabPage; + if {not ( C is TKOLTabPage ) and} not ( C is TKOLPanel ) then CONTINUE; + K := C as TKOLPanel; if K.Parent <> Self then CONTINUE; L.Add( K ); end; @@ -8981,6 +9962,169 @@ begin end; end; +function TKOLTabControl.HasCompactConstructor: Boolean; +begin + {$IFDEF _D4orHigher} + Result := TRUE; + {$ELSE} + Result := FALSE; + {$ENDIF} +end; + +function TKOLTabControl.IndexOfPage(const page_name: String): Integer; +var i: Integer; +begin + for i := 0 to Count-1 do + begin + if Pages[i].Name = page_name then + begin + Result := i; + Exit; + end; + end; + Result := -1; +end; + +{procedure TKOLTabControl.Loaded; +begin + inherited; + Beep; +end;} + +procedure TKOLTabControl.Loaded; +var i, j: Integer; + P: TKOLPanel; + P2: TKOLTabPage; + n: String; + L0, L, L2: TList; + C: TControl; +begin + inherited; + L := TList.Create; + L0 := TList.Create; + //{}ShowMessage( 'KOLTabPage ' + Name + ' loaded!' ); + TRY + for i := 0 to Count-1 do + begin + if Pages[i] is TKOLPanel then + L0.Add( Pages[i] ); + end; + for i := 0 to L0.Count-1 do + begin + P := TKOLPanel( L0[i] ); + if (P is TKOLPanel) and not(P is TKOLTabPage) then + begin + //{}ShowMessage( 'Page ' + IntToStr( i ) + ' will be converted to TKOLTabPage' ); + P2 := TKOLTabPage.Create( P.Owner ); + P2.Parent := Self; + //{}ShowMessage( 'Page ' + IntToStr( i ) + ' is converting to TKOLTabPage (1) - P2 created ' ); + n := P.Name; + P.Name := ''; + P2.Name := n; /////////////////////////////////////// + //{}ShowMessage( 'Page ' + IntToStr( i ) + ' is converting to TKOLTabPage (2) - name assigned' ); + P2.BoundsRect := P.BoundsRect; ////////////////////// + P2.TabOrder := P.TabOrder; ////////////////////////// + //{}ShowMessage( 'Page ' + IntToStr( i ) + ' is converting to TKOLTabPage (3) - TabOrder assigned' ); + P2.Align := P.Align; //////////////////////////////// + P2.Tag := P.Tag; //////////////////////////////////// + P2.IgnoreDefault := P.IgnoreDefault; + P2.AnchorLeft := P.AnchorLeft; + P2.AnchorTop := P.AnchorTop; + P2.AnchorRight := P.AnchorTop; + P2.AnchorBottom := P.AnchorBottom; + P2.AcceptChildren := TRUE; + P2.MouseTransparent := P.MouseTransparent; + P2.MinWidth := P.MinWidth; + P2.MinHeight := P.MinHeight; + P2.MaxWidth := P.MaxWidth; + P2.MaxHeight := P.MaxHeight; + P2.Visible := P.Visible; + P2.Enabled := P.Enabled; + P2.DoubleBuffered := P.DoubleBuffered; + P2.CenterOnParent := P.CenterOnParent; + //{}ShowMessage( 'Page ' + IntToStr( i ) + ' is converting to TKOLTabPage (4) - something assigned' ); + P2.Caption := P.Caption; //////////////////////////// + //{}ShowMessage( 'Page ' + IntToStr( i ) + ' is converting to TKOLTabPage (5) - Caption assigned' ); + P2.Ctl3D := P.Ctl3D; //////////////////////////////// + P2.Color := P.Color; //////////////////////////////// + P2.parentColor := P.parentColor; //////////////////// + P2.Font.Assign( P.Font ); + P2.parentFont := P.parentFont; + P2.EraseBackground := P.EraseBackground; + P2.Localizy := P.Localizy; + P2.Transparent := P.Transparent; + P2.TextAlign := P.TextAlign; + P2.edgeStyle := P.edgeStyle; + P2.VerticalAlign := P.VerticalAlign; + P2.Border := P.Border; + P2.MarginTop := P.MarginTop; + P2.MarginBottom := P.MarginBottom; + P2.MarginLeft := P.MarginLeft; + P2.MarginRight := P.MarginRight; + P2.Brush.Assign( P.Brush ); + P2.ShowAccelChar := P.ShowAccelChar; + //{}ShowMessage( 'Page ' + IntToStr( i ) + ' is converting to TKOLTabPage (6) - more props assigned' ); + L2 := TList.Create; + TRY + for j := 0 to P.ControlCount-1 do + begin + C := P.Controls[j]; + L2.Add( C ); + end; + for j := 0 to L2.Count-1 do + begin + C := TControl( L2[j] ); + C.Parent := P2; + end; + FINALLY + L2.Free; + END; + //{}ShowMessage( 'Page ' + IntToStr( i ) + ' was converted to TKOLTabPage' ); + L.Add( P ); + end; + end; + if L.Count > 0 then + ShowMessage( 'Please note that TKOLTabControl component ' + Name + + ' was created in elder version of MCK so its pages (' + IntToStr( L.Count ) + + ') was converted from TKOLPanel to TKOLTabPage.' + #13#10#13#10 + + 'To finish converting it remove empty duplicated pages manually ' + + '(select it clicking by mouse and delete pressing DELETE key, to ' + + 'switch pages use double click on tabs as usual). Then' + + ' save the form (Ctrl+S) and' + + ' answer Yes to a request' + + ' for correcting tabs declaration (this should be safe). ' + + 'Such question will be answered for each tab in the Tab control.' + + #13#10#13#10 + + '----- translation to Russian -----'#13#10#13#10 + + 'Обратите внимание, что компонент ' + Name + ' класса TKOLTabControl ' + + 'был создан в ранних версиях MCK и его страницы отконвертированы ' + + 'из класса TKOLPanel в TKOLTabPage.' + #13#10#13#10 + + 'Для завершения конвертирования вручную удалите с табулированного контрола ' + + 'лишние пустые страницы (выделяя их кликом мыши и нажимая DELETE, для ' + + 'переключения страниц мспользуйте двойной клик по закладке как обычно). ' + + 'Затем сохраните форму ' + + '(Ctrl+S) и ответьте Yes на запрос с заголовком Error и с текстом вида '#13#10 + + '"Field Form1.TabControl1_Tab0 should be of type TKOLTabPage but it is ' + + 'declared as TKOLPanel. Correct the declaration?". Такой вопрос будет задан ' + + 'для каждой страницы табулированного контрола отдельно.' ); + (*for j := 0 to L0.Count-1 do + begin + P := TKOLPanel( L[j] ); + if not(P is TKOLTabPage) and (P is TKOLPanel) then + begin + //{}ShowMessage( 'Old Page ' + IntToStr( j ) + ' will be destroyed' ); + P.Parent := nil; + //ShowMessage( 'Old Page ' + IntToStr( j ) + ' detached from parent' ); + P.Free; + //{}ShowMessage( 'Old Page ' + IntToStr( j ) + ' freed' ); + end; + end;*) + FINALLY + L.Free; + L0.Free; + END; +end; + function TKOLTabControl.NoDrawFrame: Boolean; begin Result := TRUE; @@ -8991,7 +10135,7 @@ var R, CurR: TRect; I, Tw, Sx, Sy, W, H: Integer; S : String; - CurPage: TKOLTabPage; + CurPage: TKOLPanel; M: PRect; DirXX_YY,DirXY_YX:SmallInt; O_V, O_B, O_BTN, O_F, O_BRD: Boolean; @@ -9338,11 +10482,23 @@ begin nparams := 3; end; +{procedure TKOLTabControl.ReadNewTabControl(Reader: TReader); +begin + ShowMessage( 'Reader is reading NewTabControl property' ); + LogFileOutput( 'C:\log_TC.txt', 'Reader is reading NewTabControl property' ); + fNewTabControl := Reader.ReadBoolean; + //if not fNewTabControl then + begin + Reader.OnFindComponentClass := WhenFindComponentClass; + Reader.OnSetName := WhenReaderSetsName; + end; +end;} + procedure TKOLTabControl.SchematicPaint; var R: TRect; I, Tw, Th: Integer; S: String; - CurPage: TKOLTabPage; + CurPage: TKOLPanel; M: PRect; begin asm @@ -9417,7 +10573,7 @@ begin end; procedure TKOLTabControl.SetCount(const Value: Integer); -var Pg: TKOLTabPage; +var Pg: TKOLPanel; I: Integer; S: String; begin @@ -9443,9 +10599,7 @@ begin Pg.Parent := Self; Pg.Name := S; Pg.Caption := 'Tab' + IntToStr( I ); - //Pg.BevelOuter := bvNone; Pg.edgeStyle := esNone; - //Pg.Align := caClient; Inc( I ); end; AdjustPages; @@ -9454,7 +10608,6 @@ begin end; procedure TKOLTabControl.SetCurIndex(const Value: Integer); -//var Pg: TKOLTabPage; begin asm jmp @@e_signature @@ -9473,12 +10626,6 @@ begin FCurPage.BringToFront; Invalidate; end; - {Pg := Pages[ Value ]; - if Pg <> nil then - begin - Pg.BringToFront; - Invalidate; - end;} Change; end; @@ -9542,8 +10689,27 @@ begin Change; end; +procedure TKOLTabControl.SetupConstruct_Compact; +var KF: TKOLForm; + i: Integer; +begin + inherited; + {$IFDEF _D4orHigher} + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewTabControl', TRUE, TRUE ); + KF.FormAddNumParameter( Count ); + for i := 0 to Count-1 do + KF.FormAddStrParameter( Pages[i].Caption ); + KF.FormAddNumParameter( PByte( @ Options )^ ); + KF.FormAddNumParameter( ImageList1stIdx ); + {$ELSE} + {$ENDIF} +end; + procedure TKOLTabControl.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -9552,9 +10718,16 @@ begin @@e_signature: end; inherited; + KF := ParentKOLForm; case edgeType of esLowered:; - esRaised: SL.Add( Prefix + AName + '.Style := ' + AName + + esRaised: + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetStyle' ); + KF.FormAddNumParameter( WS_THICKFRAME ); + end else + SL.Add( Prefix + AName + '.Style := ' + AName + '.Style or WS_THICKFRAME;' ); //esNone, esTransparent, esSolid: ; end; @@ -9562,6 +10735,7 @@ end; procedure TKOLTabControl.SetupLast(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -9570,14 +10744,19 @@ begin @@e_signature: end; inherited; - if CurIndex > 0 then + KF := ParentKOLForm; + if CurIndex > 0 then begin - //SL.Add( Prefix + ' ' + AName + '.GetWindowHandle;' ); - //SL.Add( Prefix + ' ' + AName + '.CreateWindow;' ); - SL.Add( Prefix + ' ' + AName + '.CurIndex := ' + IntToStr( CurIndex ) + ';' ); - //SL.Add( Prefix + ' PostMessage( ' + AName + '.GetWindowHandle, TCM_SETCURSEL, ' + IntToStr( CurIndex ) + - // ', 0 );' ); - SL.Add( Prefix + ' ' + AName + '.Pages[ ' + IntToStr( CurIndex ) + ' ].BringToFront;' ); + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetCurrentTab' ); + KF.FormAddNumParameter( CurIndex ); + end + else + begin + SL.Add( Prefix + ' ' + AName + '.CurIndex := ' + IntToStr( CurIndex ) + ';' ); + SL.Add( Prefix + ' ' + AName + '.Pages[ ' + IntToStr( CurIndex ) + ' ].BringToFront;' ); + end; end; end; @@ -9655,6 +10834,11 @@ begin + ', ' + IntToStr( ImageList1stIdx ); end; +function TKOLTabControl.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLTabControl.TabStopByDefault: Boolean; begin asm @@ -9666,6 +10850,34 @@ begin Result := TRUE; end; +{procedure TKOLTabControl.WhenFindComponentClass(Reader: TReader; + const CClassName: string; var CComponentClass: TComponentClass); +begin + if (pos( '_Tab', fNameSetByReader ) > 0) + and (CClassName = 'TKOLPanel') then + begin + CComponentClass := TKOLTabPage; + ShowMessage( 'TKOLPanel class replaced with TKOLTabPage for ' + fNameSetByReader ); + end + else + inherited; +end; + +procedure TKOLTabControl.WhenReaderSetsName(Reader: TReader; + Component: TComponent; var AName: string); +begin + inherited; + fNameSetByReader := AName; + ShowMessage( 'Reader sets name ' + AName ); + LogFileOutput( 'C:\log_TC.txt', 'Reader sets name ' + AName ); +end; + +procedure TKOLTabControl.WriteNewTabControl(Writer: TWriter); +begin + Writer.WriteBoolean( TRUE ); +end; +} + function TKOLTabControl.WYSIWIGPaintImplemented: Boolean; begin Result := TRUE; @@ -10078,8 +11290,8 @@ begin Result := FALSE; if S = '' then Exit; for I := 1 to Length( S ) do - if not( S[ I ] in [ '0'..'9' ] ) then - Exit; + if (S[ I ] < '0') or (S[ I ] > '9') then + Exit; Result := TRUE; end; @@ -10432,6 +11644,28 @@ var RsrcFile, RsrcName: String; Bmp: TBitmap; Bt, Bt1: TKOLToolbarButton; Btn1st: Integer; + KF: TKOLForm; + {$IFDEF not_economy_code_size} + TipsList: TStringList; + {$ENDIF} + Buttons_Count: Integer; + Images_Count: Integer; + Buttons_List: String; + ImageIndexes_List: String; + /////////////////////////////////// + function IndexOfBeginLine: Integer; + var i: Integer; + begin + for i := 0 to SL.Count-1 do + begin + if SL[i] = 'begin' then + begin + Result := i; + Exit; + end; + end; + Result := 1; + end; ////////////////////////////// begin asm jmp @@e_signature @@ -10439,334 +11673,484 @@ begin DB 'TKOLToolbar.SetupFirst', 0 @@e_signature: end; + KF := ParentKOLForm; + RsrcName := ''; H := MaxBtnImgHeight; W := MaxBtnImgWidth; if W * H > 0 then begin - RsrcName := UpperCase( ParentKOLForm.FormName ) + '_TBBMP' + IntToStr( FResBmpID ); - RsrcFile := ParentKOLForm.FormName + '_' + Name; - SL.Add( Prefix + ' {$R ' + RsrcFile + '.res}' ); - Bmp := TBitmap.Create; - TRY - N := 0; - FBmpTranColor := clNone; - for I := 0 to Items.Count-1 do - begin - Bt := Items[ I ]; - if Bt.HasPicture then + RsrcName := UpperCase( ParentKOLForm.FormName ) + '_TBBMP' + IntToStr( FResBmpID ); + RsrcFile := ParentKOLForm.FormName + '_' + Name; + (SL as TFormStringList).OnAdd := nil; + SL.Add( Prefix + ' {$R ' + RsrcFile + '.res}' ); + if KF <> nil then + (SL as TFormStringList).OnAdd := KF.DoFlushFormCompact; + Bmp := TBitmap.Create; + TRY + N := 0; + FBmpTranColor := clNone; + for I := 0 to Items.Count-1 do begin - if FBmpTranColor = clNone then + Bt := Items[ I ]; + if Bt.HasPicture then begin - Bmp.Assign( Bt.picture ); - FBmpTranColor := Bmp.Canvas.Pixels[ 0, Bmp.Height - 1 ]; + if FBmpTranColor = clNone then + begin + Bmp.Assign( Bt.picture ); + FBmpTranColor := Bmp.Canvas.Pixels[ 0, Bmp.Height - 1 ]; + end; + Inc( N ); end; - Inc( N ); end; - end; - Bmp.Width := N * W; - Bmp.Height := H; - {$IFNDEF _D2} - Bmp.PixelFormat := pf24bit; - {$ENDIF} - if FBmpTranColor <> clNone then - begin - Bmp.Canvas.Brush.Color := FBmpTranColor; - Bmp.Canvas.FillRect( Rect( 0, 0, Bmp.Width, Bmp.Height ) ); - end; - N := 0; - for I := 0 to Items.Count-1 do - begin - Bt := Items[ I ]; - if Bt.HasPicture then + Bmp.Width := N * W; + Bmp.Height := H; + {$IFNDEF _D2} + Bmp.PixelFormat := pf24bit; + {$ENDIF} + if FBmpTranColor <> clNone then begin - Bmp.Canvas.Draw( N * W, 0, Bt.picture.Graphic ); - Inc( N ); + Bmp.Canvas.Brush.Color := FBmpTranColor; + Bmp.Canvas.FillRect( Rect( 0, 0, Bmp.Width, Bmp.Height ) ); end; - end; - GenerateBitmapResource( Bmp, RsrcName, RsrcFile, fUpdated ); - FINALLY - Bmp.Free; - END; + N := 0; + for I := 0 to Items.Count-1 do + begin + Bt := Items[ I ]; + if Bt.HasPicture then + begin + Bmp.Canvas.Draw( N * W, 0, Bt.picture.Graphic ); + Inc( N ); + end; + end; + GenerateBitmapResource( Bmp, RsrcName, RsrcFile, fUpdated ); + FINALLY + Bmp.Free; + END; end; - if HeightAuto then + if HeightAuto then begin - DefaultHeight := Height; - DefaultWidth := Width; + DefaultHeight := Height; + DefaultWidth := Width; end else begin - if Align in [ caTop, caBottom, caNone ] then - begin - DefaultHeight := 22; - DefaultWidth := Width; - end - else - if Align in [ caLeft, caRight ] then - begin - DefaultHeight := Height; - DefaultWidth := 44; - end - else - begin - DefaultHeight := Height; - DefaultWidth := Width; - end; - end; - inherited; - if Assigned( bitmap ) and (bitmap.Width * bitmap.Height > 0) then - begin - W := MaxBtnImgWidth; - H := MaxBtnImgHeight; - if (W <> H) or (StandardImagesUsed > 0) then - begin - SL.Add( ' ' + Prefix + AName + '.TBBtnImgWidth := ' + IntToStr( W ) + ';' ); - S := ' ' + Prefix + AName + '.TBAddBitmap( '; - if mapBitmapColors then - S := S + 'LoadMappedBitmapEx( ' + AName + ', hInstance, ''' + RsrcName + ''', [ ' + - Color2Str( FBmpTranColor ) + ', Color2RGB( clBtnFace ) ] ) );' - else - S := S + 'LoadBmp( hInstance, ''' + RsrcName + ''', ' + - AName + ' ) );'; - SL.Add( S ); - end; - end; - if TBButtonsWidth > 0 then - SL.Add( ' ' + Prefix + AName + '.Perform( TB_SETBUTTONSIZE, ' + - IntToStr( TBButtonsWidth ) + ', 0 );' ); - if ((StandardImagesUsed > 0) and (PicturedButtonsCount > 0)) or - not IntIn(StandardImagesUsed, [ 1, 2, 4 ]) then - begin - if LongBool( StandardImagesUsed and 1 ) then - begin - if StandardImagesLarge then - S := '-2' - else - S := '-1'; - SL.Add( ' ' + Prefix + AName + '.TBAddBitmap( THandle( ' + S + ' ) );' ); - end; - if LongBool( StandardImagesUsed and 2 ) then - begin - if StandardImagesLarge then - S := '-6' - else - S := '-5'; - SL.Add( ' ' + Prefix + AName + '.TBAddBitmap( THandle( ' + S + ' ) );' ); - end; - if LongBool( StandardImagesUsed and 4 ) then - begin - if StandardImagesLarge then - S := '-10' - else - S := '-9'; - SL.Add( ' ' + Prefix + AName + '.TBAddBitmap( THandle( ' + S + ' ) );' ); - end; + if Align in [ caTop, caBottom, caNone ] then + begin + DefaultHeight := 22; + DefaultWidth := Width; + end else + if Align in [ caLeft, caRight ] then + begin + DefaultHeight := Height; + DefaultWidth := 44; + end else + begin + DefaultHeight := Height; + DefaultWidth := Width; + end; end; - if showTooltips or (tooltips.Count > 0) then + inherited; ////////////////////////////////////////////////////////////////// + + if AutosizeButtons then + SL.Add( ' ' + Prefix + AName + '.TBAutoSizeButtons := TRUE;' ); + + if Assigned( bitmap ) and (bitmap.Width * bitmap.Height > 0) then begin - S := ''; - J := 0; - for I := 0 to Items.Count-1 do - begin - Bt := Items[ I ]; - //if Bt.Faction <> nil then continue; // remove by YS 7-Aug-2004 - //if Bt.separator then continue; + W := MaxBtnImgWidth; + H := MaxBtnImgHeight; + if (W <> H) or (StandardImagesUsed > 0) then + begin + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetTBBtnImgWidth' ); + KF.FormAddNumParameter( W ); + end else + SL.Add( ' ' + Prefix + AName + '.TBBtnImgWidth := ' + IntToStr( W ) + ';' ); - //---------{ Maxim Pushkar }---------------------------------------------- - //if (tooltips.Count > 0) and (J > tooltips.Count) then break; - //----------------------------------------------------------------------// - if (tooltips.Count > 0) and (J >= tooltips.Count) then break; // - //--------------------------------------------------------------------// + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormTBAddBitmap' ); + KF.FormAddStrParameter( RsrcName ); + KF.FormAddNumParameter( Integer(mapBitmapColors) ); + if mapBitmapColors then + KF.FormAddNumParameter( (FBmpTranColor shl 1) or (FBmpTranColor shr 31) ); + end + else + begin + S := ' ' + Prefix + AName + '.TBAddBitmap( '; + if mapBitmapColors then + S := S + 'LoadMappedBitmapEx( ' + AName + ', hInstance, ''' + RsrcName + ''', [ ' + + Color2Str( FBmpTranColor ) + ', Color2RGB( clBtnFace ) ] ) );' + else + S := S + 'LoadBmp( hInstance, ''' + RsrcName + ''', ' + + AName + ' ) );'; + SL.Add( S ); + end; + end; + end + else if NoSpaceForImages then + begin + SL.Add( ' ' + Prefix + AName + '.Perform( TB_SETBITMAPSIZE, 0, 16 shl 16 );' ); + end; - if Bt.Tooltip <> '' then - B := Bt.Tooltip + if ((StandardImagesUsed > 0) and (PicturedButtonsCount > 0)) or + not IntIn(StandardImagesUsed, [ 1, 2, 4 ]) then + begin + if LongBool( StandardImagesUsed and 1 ) then + begin + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormTBAddBitmap' ); + if StandardImagesLarge then + KF.FormAddNumParameter( -2 ) + else + KF.FormAddNumParameter( -1 ); + end else + begin + if StandardImagesLarge then + S := '-2' + else + S := '-1'; + SL.Add( ' ' + Prefix + AName + '.TBAddBitmap( THandle( ' + S + ' ) );' ); + end; + end; + + if LongBool( StandardImagesUsed and 2 ) then + begin + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormTBAddBitmap' ); + if StandardImagesLarge then + KF.FormAddNumParameter( -6 ) + else + KF.FormAddNumParameter( -5 ); + end else + begin + if StandardImagesLarge then + S := '-6' + else + S := '-5'; + SL.Add( ' ' + Prefix + AName + '.TBAddBitmap( THandle( ' + S + ' ) );' ); + end; + end; + + if LongBool( StandardImagesUsed and 4 ) then + begin + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormTBAddBitmap' ); + if StandardImagesLarge then + KF.FormAddNumParameter( -10 ) + else + KF.FormAddNumParameter( -9 ); + end else + begin + if StandardImagesLarge then + S := '-10' + else + S := '-9'; + SL.Add( ' ' + Prefix + AName + '.TBAddBitmap( THandle( ' + S + ' ) );' ); + end; + end; + end; + + if (TBButtonsWidth > 0) or AutoSizeButtons then + begin + S := '0'; + if StandardImagesUsed > 0 then else - if (tooltips.Count > 0) and (tooltips[ J ] <> '') and not Bt.separator then - B := tooltips[ J ] - else - if showTooltips then - B := Bt.Caption - else - B := ''; - if Bt.Faction = nil then // {YS} добавить - begin // {YS} добавить - if not Bt.separator then // {YS} добавить - begin - if S <> '' then - S := S + ', '; - {$IFDEF _D2009orHigher} - C2 := ''; - C := StringConstant( Bt.Name + '_tip', B ); - for Z := 2 to Length(C) - 1 do C2 := C2 + '#'+int2str(ord(C[Z])); - S := S + C2; - {$ELSE} - S := S + PCharStringConstant( Self, Bt.Name + '_tip', B ); - {$ENDIF} - end - else - //+++++++ v1.94 - begin - if S <> '' then - S := S + ', ''''' - else - S := S + ''''''; - end; - //------ - end // {YS} добавить - else // {YS} добавить - Inc( J ); - end; - // change by Alexander Pravdin (to fix tooltips for case of first separator): - //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - Btn1st := 0; - {for i := 0 to ButtonCount - 1 do - if not TKOLToolbarButton( FItems.Items[i] ).Fseparator then begin - Btn1st := i; - Break; - end;} - if S <> '' then - begin - SL.Add( Prefix + ' {$IFDEF USE_GRUSH}' ); - SL.Add( Prefix + ' ToolbarSetTooltips( ' + AName + ', ' + - AName + '.TBIndex2Item( ' + IntToStr( Btn1st ) + ' ), [ ' + S + ' ] );' ); - SL.Add( Prefix + ' {$ELSE}' ); - SL.Add( Prefix + ' ' + AName + '.TBSetTooltips( ' + AName + - '.TBIndex2Item( ' + IntToStr( Btn1st ) + ' ), [ ' + S + ' ] );' ); - SL.Add( Prefix + ' {$ENDIF}' ); - end; - //-------------------------------------------------------------------------- - {if S <> '' then - SL.Add( Prefix + ' ' + AName + '.TBSetTooltips( ' + AName + - '.TBIndex2Item( 0 ), [ ' + S + ' ] );' );} - //////////////////////////////////////////////////////////////////////////// + if (Bitmap.Width > 0) and (Bitmap.Height > 0) and + (FResBmpID >= 0) and (MaxBtnImgWidth = MaxBtnImgHeight) and + (StandardImagesUsed=0) then + begin + if mapBitmapColors then + S := 'LoadMappedBitmapEx( Result, hInstance, ''' + + UpperCase( ParentKOLForm.FormName ) + '_TBBMP' + IntToStr( FResBmpID ) + ''', [ ' + + Color2Str( FBmpTranColor ) + ', Color2RGB( clBtnFace ) ] ) ' + else + S := 'LoadBmp( hInstance, PChar( ''' + + UpperCase( ParentKOLForm.FormName ) + '_TBBMP' + IntToStr( FResBmpID ) + + ''' ), Result ) '; + end; + + + Buttons_List := ButtonCaptionsList( Buttons_Count ); + ImageIndexes_List := ButtonImgIndexesList( Images_Count ); + SL.Insert( IndexOfBeginLine, 'const ToolbarButtonsArray_' + Name + ': array[' + + '0..' + IntToStr(Buttons_Count-1) + '] of PKOLChar = (' + + Buttons_List + ');'); + SL.Insert( IndexOfBeginLine, 'const ToolbarImgIndexesArray_' + Name + ': array[' + + '0..' + IntToStr(Images_Count-1) + '] of Integer = (' + + ImageIndexes_List + ');' ); + SL.Add( ' ' + Prefix + 'ToolbarAddButtons( ' + AName + ', ' + + //'['#13#10 + + //' ' + ButtonCaptionsList + ' ],'#13#10 + + ' ToolbarButtonsArray_' + Name + ',' + + //' ' + ButtonImgIndexesList + ','#13#10 + + ' ToolbarImgIndexesArray_' + Name + ',' + + ' ' + S + ' );' ); + if AutosizeButtons then + begin + SL.Add( ' ' + Prefix + AName + '.Perform( TB_SETBUTTONSIZE, 0, ' + + IntToStr( TBButtonsWidth ) + ' or $10000' + + //' or $FFFF0000 and (' + AName + '.Perform( TB_GETBUTTONSIZE, 0, 0 ) )' + + ' );' ); + end; + end; + + if showTooltips or (tooltips.Count > 0) then + begin + //{$IFDEF _D4orHigher} + {$IFDEF not_economy_code_size} + if (KF <> nil) and KF.FormCompact then + begin + TipsList := TStringList.Create; + TRY + J := 0; + for I := 0 to Items.Count-1 do + begin + Bt := Items[ I ]; + if (tooltips.Count > 0) and (J >= tooltips.Count) then break; + + if Bt.Tooltip <> '' then + B := Bt.Tooltip + else + if (tooltips.Count > 0) and (tooltips[ J ] <> '') and not Bt.separator then + B := tooltips[ J ] + else + if showTooltips then + B := Bt.Caption + else + B := ''; + if Bt.Faction = nil then // {YS} добавить + begin // {YS} добавить + if not Bt.separator then // {YS} добавить + TipsList.Add( B ) + else + TipsList.Add( '' ); + //------ + end else // {YS} добавить + Inc( J ); + end; + if TipsList.Count > 0 then + begin + KF.FormAddCtlCommand( Name, 'FormTBSetTooltips' ); + KF.FormAddNumParameter( TipsList.Count ); + for I := 0 to TipsList.Count-1 do + KF.FormAddStrParameter( TipsList[I] ); + end; + FINALLY + TipsList.Free; + END; + end + else + {$ENDIF} + begin + S := ''; + J := 0; + for I := 0 to Items.Count-1 do + begin + Bt := Items[ I ]; + //if Bt.Faction <> nil then continue; // remove by YS 7-Aug-2004 + //if Bt.separator then continue; + + //---------{ Maxim Pushkar }---------------------------------------------- + //if (tooltips.Count > 0) and (J > tooltips.Count) then break; + //----------------------------------------------------------------------// + if (tooltips.Count > 0) and (J >= tooltips.Count) then break; // + //--------------------------------------------------------------------// + + if Bt.Tooltip <> '' then + B := Bt.Tooltip + else + if (tooltips.Count > 0) and (tooltips[ J ] <> '') and not Bt.separator then + B := tooltips[ J ] + else + if showTooltips then + B := Bt.Caption + else + B := ''; + if Bt.Faction = nil then // {YS} добавить + begin // {YS} добавить + if not Bt.separator then // {YS} добавить + begin + if S <> '' then + S := S + ', '; + {$IFDEF _D2009orHigher} + C2 := ''; + C := StringConstant( Bt.Name + '_tip', B ); + for Z := 2 to Length(C) - 1 do + C2 := C2 + '#'+int2str(ord(C[Z])); + S := S + C2; + {$ELSE} + S := S + PCharStringConstant( Self, Bt.Name + '_tip', B ); + {$ENDIF} + end else + //+++++++ v1.94 + begin + if S <> '' then + S := S + ', ''''' + else + S := S + ''''''; + end; + //------ + end else // {YS} добавить + Inc( J ); + end; + // change by Alexander Pravdin (to fix tooltips for case of first separator): + //++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ + Btn1st := 0; + {for i := 0 to ButtonCount - 1 do + if not TKOLToolbarButton( FItems.Items[i] ).Fseparator then begin + Btn1st := i; + Break; + end;} + if S <> '' then + begin + SL.Add( Prefix + ' {$IFDEF USE_GRUSH}' ); + SL.Add( Prefix + ' ToolbarSetTooltips( ' + AName + ', ' + + AName + '.TBIndex2Item( ' + IntToStr( Btn1st ) + ' ), [ ' + S + ' ] );' ); + SL.Add( Prefix + ' {$ELSE}' ); + SL.Add( Prefix + ' ' + AName + '.TBSetTooltips( ' + AName + + '.TBIndex2Item( ' + IntToStr( Btn1st ) + ' ), [ ' + S + ' ] );' ); + SL.Add( Prefix + ' {$ENDIF}' ); + end; + //-------------------------------------------------------------------------- + end; end; // assign image list if used: - if ImageListNormal <> nil then + if ImageListNormal <> nil then begin - SL.Add( Prefix + ' ' + AName + '.Perform( TB_SETIMAGELIST, 0, Result.' + - ImageListNormal.Name + '.Handle );' ); + SL.Add( Prefix + ' ' + AName + '.Perform( TB_SETIMAGELIST, 0, Result.' + + ImageListNormal.Name + '.Handle );' ); end; - if ImageListDisabled <> nil then + if ImageListDisabled <> nil then begin - SL.Add( Prefix + ' ' + AName + '.Perform( TB_SETDISABLEDIMAGELIST, 0, Result.' + - ImageListDisabled.Name + '.Handle );' ); + SL.Add( Prefix + ' ' + AName + '.Perform( TB_SETDISABLEDIMAGELIST, 0, Result.' + + ImageListDisabled.Name + '.Handle );' ); end; - if ImageListHot <> nil then + if ImageListHot <> nil then begin - SL.Add( Prefix + ' ' + AName + '.Perform( TB_SETHOTIMAGELIST, 0, Result.' + - ImageListHot.Name + '.Handle );' ); + SL.Add( Prefix + ' ' + AName + '.Perform( TB_SETHOTIMAGELIST, 0, Result.' + + ImageListHot.Name + '.Handle );' ); end; I0 := -1; for I := 0 to Items.Count-1 do begin - Bt := Items[ I ]; - Inc( I0 ); - //if Bt.separator then Continue; - if Bt.fOnClickMethodName <> '' then - begin - S := ''; - for J := I to Items.Count - 1 do + Bt := Items[ I ]; + Inc( I0 ); + //if Bt.separator then Continue; + if Bt.fOnClickMethodName <> '' then begin - Bt := Items[ J ]; - //if Bt.separator then Continue; - if Bt.separator or (Bt.fOnClickMethodName = '') then - begin - N := 0; - for K := J to Items.Count-1 do + S := ''; + for J := I to Items.Count - 1 do begin - Bt1 := Items[ K ]; - if Bt1.separator then Continue; - if Bt1.fOnClickMethodName <> '' then - begin - Inc( N ); - break; - end; + Bt := Items[ J ]; + //if Bt.separator then Continue; + if Bt.separator or (Bt.fOnClickMethodName = '') then + begin + N := 0; + for K := J to Items.Count-1 do + begin + Bt1 := Items[ K ]; + if Bt1.separator then Continue; + if Bt1.fOnClickMethodName <> '' then + begin + Inc( N ); + break; + end; + end; + if N = 0 then break; + end; + if S <> '' then S := S + ', '; + if Bt.fOnClickMethodName <> '' then + S := S + 'Result.' + Bt.fOnClickMethodName + else + S := S + 'nil'; end; - if N = 0 then break; - end; - if S <> '' then S := S + ', '; - if Bt.fOnClickMethodName <> '' then - S := S + 'Result.' + Bt.fOnClickMethodName - else - S := S + 'nil'; + SL.Add( ' ' + Prefix + AName + '.TBAssignEvents( ' + IntToStr( I0 ) + + ', [ ' + S + ' ] );' ); + break; end; - SL.Add( ' ' + Prefix + AName + '.TBAssignEvents( ' + IntToStr( I0 ) + - ', [ ' + S + ' ] );' ); - break; - end; end; - if TBButtonsMinWidth > 0 then - SL.Add( Prefix + AName + '.TBButtonsMinWidth := ' + IntToStr( TBButtonsMinWidth ) + ';' ); - if TBButtonsMaxWidth > 0 then - SL.Add( Prefix + AName + '.TBButtonsMaxWidth := ' + IntToStr( TBButtonsMaxWidth ) + ';' ); + if TBButtonsMinWidth > 0 then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetTBButtonsMinWidth' ); + KF.FormAddNumParameter( TBButtonsMinWidth ); + end else + SL.Add( Prefix + AName + '.TBButtonsMinWidth := ' + IntToStr( TBButtonsMinWidth ) + ';' ); + + if TBButtonsMaxWidth > 0 then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetTBButtonsMaxWidth' ); + KF.FormAddNumParameter( TBButtonsMaxWidth ); + end else + SL.Add( Prefix + AName + '.TBButtonsMaxWidth := ' + IntToStr( TBButtonsMaxWidth ) + ';' ); + for I := Items.Count-1 downto 0 do begin - Bt := Items[ I ]; - if not Bt.visible and (Bt.Faction = nil) then - begin - SL.Add( Prefix + '{$IFDEF USE_GRUSH}' ); - SL.Add( Prefix + 'ShowHideToolbarButton( ' + AName + ', ' + IntToStr( I ) + ', FALSE );' ); - SL.Add( Prefix + '{$ELSE}' ); - SL.Add( Prefix + AName + '.TBButtonVisible[ ' + IntToStr( I ) + ' ] := FALSE;' ); - SL.Add( Prefix + '{$ENDIF}' ); - end; - {if Bt.Checked and (Bt.Faction = nil) then - SL.Add( Prefix + AName + '.TBButtonChecked[ ' + IntToStr( I ) + ' ] := TRUE;' );} - if not Bt.enabled and (Bt.Faction = nil) then - begin - SL.Add( Prefix + '{$IFDEF USE_GRUSH}' ); - SL.Add( Prefix + 'EnableToolbarButton( ' + AName + ', ' + IntToStr( I ) + ', FALSE );' ); - SL.Add( Prefix + '{$ELSE}' ); - SL.Add( Prefix + AName + '.TBButtonEnabled[ ' + IntToStr( I ) + ' ] := FALSE;' ); - SL.Add( Prefix + '{$ENDIF}' ); - end; + Bt := Items[ I ]; + if not Bt.visible and (Bt.Faction = nil) then + begin + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormHideToolbarButton' ); + KF.FormAddNumParameter( I ); + end + else + begin + SL.Add( Prefix + '{$IFDEF USE_GRUSH}' ); + SL.Add( Prefix + 'ShowHideToolbarButton( ' + AName + ', ' + IntToStr( I ) + ', FALSE );' ); + SL.Add( Prefix + '{$ELSE}' ); + SL.Add( Prefix + AName + '.TBButtonVisible[ ' + IntToStr( I ) + ' ] := FALSE;' ); + SL.Add( Prefix + '{$ENDIF}' ); + end; + end; + + if not Bt.enabled and (Bt.Faction = nil) then + begin + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormDisableToolbarButton' ); + KF.FormAddNumParameter( I ); + end + else + begin + SL.Add( Prefix + '{$IFDEF USE_GRUSH}' ); + SL.Add( Prefix + 'EnableToolbarButton( ' + AName + ', ' + IntToStr( I ) + ', FALSE );' ); + SL.Add( Prefix + '{$ELSE}' ); + SL.Add( Prefix + AName + '.TBButtonEnabled[ ' + IntToStr( I ) + ' ] := FALSE;' ); + SL.Add( Prefix + '{$ENDIF}' ); + end; + end; end; - {if FixFlatXP then - if (tboFlat in Options) and (Parent <> nil) and not(Parent is TForm) then - begin - if Align in [ caLeft, caRight ] then - begin - SL.Add( Prefix + ' ' + AName + '.Style := ' + AName + - '.Style or TBSTYLE_WRAPABLE;' ); - end + if not Assigned( OnTBCustomDraw ) and + (tboCustomErase in Options) OR + FixFlatXP and (tboFlat in Options) then + if (KF <> nil) and KF.FormCompact then + KF.FormAddCtlCommand( Name, 'FormFixFlatXPToolbar' ) else - begin - SL.Add( Prefix + 'if WinVer >= wvXP then' ); - SL.Add( Prefix + 'begin' ); - SL.Add( Prefix + ' ' + AName + '.Style := ' + AName + - '.Style or TBSTYLE_WRAPABLE;' ); - SL.Add( Prefix + ' ' + AName + '.Transparent := TRUE;' ); - SL.Add( Prefix + 'end;' ); - end; - end;} - - if not Assigned( OnTBCustomDraw ) and - (tboCustomErase in Options) OR - FixFlatXP and (tboFlat in Options) then - begin - SL.Add( Prefix + AName + '.OnTBCustomDraw := nil;' ); - end; + SL.Add( Prefix + AName + '.OnTBCustomDraw := nil;' ); end; function TKOLToolbar.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; var {$IFDEF _D2009orHigher} - C, C2: WideString; - Z : integer; + //C: WideString; S, A: WideString; - B: WideString; + //B: WideString; {$ELSE} S, A: String; - B: String; {$ENDIF} - I, N: Integer; - Bt, Bt1: TKOLToolbarButton; - StdImagesStart, ViewImagesStart, HistImagesStart: Integer; - TheSameBefore, TheSameAfter: Boolean; + Buttons_Count: Integer; + Images_Count: Integer; begin asm jmp @@e_signature @@ -10855,137 +12239,16 @@ begin // 4. Button captions Result := Result + '[ '; - - for I := 0 to Items.Count-1 do - begin - Bt := Items[ I ]; - if Bt.separator then - Result := Result + '''-''' - else - begin - if noTextLabels then - B := ' ' - else - begin - {$IFDEF _D2009orHigher} - C2 := ''; - C := Bt.Fcaption; - for Z := 1 to Length(C) do C2 := C2 + '#'+int2str(ord(C[Z])); - B := C2; - {$ELSE} - B := Bt.Fcaption; - {$ENDIF} - end; - S := ''; - if Bt.radioGroup <> 0 then - begin - TheSameBefore := FALSE; - TheSameAfter := FALSE; - if I > 0 then - begin - Bt1 := Items[ I - 1 ]; - if not Bt1.separator and (Bt1.FradioGroup = Bt.FradioGroup) then - TheSameBefore := TRUE; - end; - if I < Items.Count-1 then - begin - Bt1 := Items[ I + 1 ]; - if not Bt1.separator and (Bt1.FradioGroup = Bt.FradioGroup) then - TheSameAfter := TRUE; - end; - if TheSameBefore or TheSameAfter then - S := '!' + S; - end; - if Bt.checked and (Bt.Faction = nil) then - S := '+' + S - else - if Bt.radioGroup <> 0 then - S := '-' + S; - if Bt.dropdown then - S := '^' + S; - if noTextLabels then - Result := Result + '''' + S + B + '''' - else - if Bt.Faction <> nil then - Result := Result + '''' + S + ' ''' - else - begin - {$IFDEF _D2009orHigher} - if B = '' then B := ''''''; - {$ELSE} - B := StringConstant( Bt.Name + '_btn', B ); - {$ENDIF} - if (B <> '') and (B[ 1 ] = '''') then - Result := Result + '''' + S + Copy( B, 2, MaxInt ) - else - if S <> '' then - Result := Result + 'PKOLChar( ''' + S + ''' + ' + B + ')' - else - Result := Result + 'PKOLChar( ' + B + ' )'; - end; - end; - if I < Items.Count-1 then - Result := Result + ', '; - end; + if (TBButtonsWidth = 0) and not AutoSizeButtons then + Result := Result + ButtonCaptionsList( Buttons_Count ); Result := Result + ' ], '; // 5. Button image indexes used + if (TBButtonsWidth = 0) and not AutosizeButtons then + Result := Result + '[ ' + ButtonImgIndexesList( Images_Count ) + ' ] ' + else + Result := Result + '[]'; //Rpt( '$$$$$$$$$$$$$$$ PicturedButtonsCount := ' + IntToStr( PicturedButtonsCount ) ); - if (StandardImagesUsed = 0) and (PicturedButtonsCount = 0) and not ImageListsUsed then - Result := Result + '[ -2 ]' else - if (StandardImagesUsed = 0) and AllPicturedButtonsAreLeading and - LastBtnHasPicture and not ImageListsUsed then - Result := Result + '[ 0 ]' else - begin - N := PicturedButtonsCount; - Result := Result + '[ '; - StdImagesStart := N; - ViewImagesStart := N; - HistImagesStart := N; - if (StandardImagesUsed > 1) and LongBool(StandardImagesUsed and 1) then - begin - ViewImagesStart := N + 15; - HistImagesStart := N + 15; - end; - if LongBool(StandardImagesUsed and 2) then - HistImagesStart := HistImagesStart + 12; - N := 0; - S := ''; - for I := 0 to Items.Count-1 do - begin - Bt := Items[ I ]; - //Rpt( '%%%%%%%%%% Bt ' + Bt.Name + ' HasPicture := ' + IntToStr( Integer( Bt.HasPicture ) ) ); - if ImageListsUsed then - begin - if Bt.imgIndex >= 0 then - S := IntToStr( Bt.imgIndex ) - else - S := '-2'; - end - else - if Bt.HasPicture then - begin - S := IntToStr( N ); - Inc( N ); - end - else - case Bt.sysimg of - stiCustom: - S := '-2'; // I_IMAGENONE - stdCUT..stdPRINT: - S := IntToStr( StdImagesStart + Ord( Bt.sysimg ) - Ord( stdCUT ) ); - viewLARGEICONS..viewVIEWMENU: - S := IntToStr( ViewImagesStart + Ord( Bt.sysimg ) - Ord( viewLARGEICONS ) ); - else - S := IntToStr( HistImagesStart + Ord( Bt.sysimg ) - Ord( histBACK ) ); - end; - Result := Result + S + ', '; - end; - if Items.Count > 0 then - Result := Copy( Result, 1, Length( Result ) - 2 ) + ' ]' - else - Result := Result + ']'; - end; end; var LastToolbarWarningtime: Integer; @@ -11599,24 +12862,28 @@ begin inherited; if generateVariables then begin - S := ''; - for I := 0 to Items.Count-1 do - begin - Bt := Items[ I ]; - if Bt.separator and (Copy( Bt.Name, 1, 2 ) = 'TB') and - IsNumber( Copy( Bt.Name, 3, MaxInt ) ) then - continue; - if Bt.Name <> '' then + S := ''; + for I := 0 to Items.Count-1 do begin - S := S + ',' + Bt.Name; + Bt := Items[ I ]; + if Bt.separator and (Copy( Bt.Name, 1, 2 ) = 'TB') and + IsNumber( Copy( Bt.Name, 3, MaxInt ) ) then + continue; + if Bt.Name <> '' then + begin + S := S + ',' + Bt.Name; + end; + end; + if ( S <> '' ) then + begin + Delete( S, 1, 1 ); + SL.Add( ' ' + Prefix + AName + '.TBConvertIdxArray2ID( [' + S + '] );' ); end; - end; - if ( S <> '' ) then - begin - Delete( S, 1, 1 ); - SL.Add( Prefix + AName + '.TBConvertIdxArray2ID( [' + S + '] );' ); - end; end; + + if AutoSize then + SL.Add( ' ' + Prefix + AName + '.Perform( TB_AUTOSIZE, 0, 0 );' ); + end; procedure TKOLToolbar.P_SetupLast(SL: TStringList; const AName, AParent, @@ -12365,6 +13632,366 @@ begin [ @ OnTBCustomDraw ] ); end; +procedure TKOLToolbar.SetupConstruct_Compact; +var KF: TKOLForm; + i, N: Integer; + Bt, Bt1: TKOLToolbarButton; + s, B: String; + TheSameBefore, TheSameAfter: Boolean; + StdImagesStart, ViewImagesStart, HistImagesStart: Integer; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewToolbar', TRUE, TRUE ); + KF.FormAddNumParameter( Integer( Align ) ); + KF.FormAddNumParameter( PInteger( @ Options )^ ); + if (Bitmap.Width > 0) and (Bitmap.Height > 0) and + (FResBmpID >= 0) and (MaxBtnImgWidth = MaxBtnImgHeight) and + (StandardImagesUsed=0) then + begin + KF.FormAddNumParameter( Integer( mapBitmapColors )+1 ); + if mapBitmapColors then + KF.FormAddNumParameter( (FBmpTranColor shl 1) or (FBmpTranColor shr 31) ); + KF.FormAddStrParameter( UpperCase( ParentKOLForm.FormName ) + + '_TBBMP' + IntToStr( FResBmpID ) ); + end + else + begin + if (PicturedButtonsCount = 0) and (IntIn( StandardImagesUsed, [ 1, 2, 4 ] )) then + begin + if StandardImagesUsed = 1 then + if StandardImagesLarge then + //Result := Result + 'THandle( -2 ), ' + KF.FormAddNumParameter( -2 ) + else + //Result := Result + 'THandle( -1 ), ' + KF.FormAddNumParameter( -1 ) + else + if StandardImagesUsed = 2 then + if StandardImagesLarge then + //Result := Result + 'THandle( -6 ), ' + KF.FormAddNumParameter( -6 ) + else + //Result := Result + 'THandle( -5 ), ' + KF.FormAddNumParameter( -5 ) + else + if StandardImagesLarge then + //Result := Result + 'THandle( -10 ), ' + KF.FormAddNumParameter( -10 ) + else + //Result := Result + 'THandle( -9 ), '; + KF.FormAddNumParameter( -9 ); + end + else + begin + if not ((Bitmap.Width > 0) and (Bitmap.Height > 0) + and (FResBmpID >= 0)) then + FResBmpID := 0; + KF.FormAddNumParameter( 0 ); + end; + end; + KF.FormAddNumParameter( Items.Count ); + for i := 0 to Items.Count-1 do + begin + Bt := Items[ I ]; + if Bt.separator then + s := '-' + else + begin + if noTextLabels then + B := ' ' + else + B := Bt.Fcaption; + s := ''; + if Bt.radioGroup <> 0 then + begin + TheSameBefore := FALSE; + TheSameAfter := FALSE; + if i> 0 then + begin + Bt1 := Items[ i - 1 ]; + if not Bt1.separator and (Bt1.FradioGroup = Bt.FradioGroup) then + TheSameBefore := TRUE; + end; + if i < Items.Count-1 then + begin + Bt1 := Items[ I + 1 ]; + if not Bt1.separator and (Bt1.FradioGroup = Bt.FradioGroup) then + TheSameAfter := TRUE; + end; + if TheSameBefore or TheSameAfter then + s := '!' + s; + end; + if Bt.checked and (Bt.Faction = nil) then + s := '+' + s + else + if Bt.radioGroup <> 0 then + s := '-' + s; + if Bt.dropdown then + s := '^' + s; + if noTextLabels then + s := s + B + else + if Bt.Faction <> nil then + // + else + begin + B := Bt.Name; + if (B <> '') and (B[ 1 ] = '''') then + s := s + Copy( B, 2, MaxInt ) + else + s := s + B; + end; + end; + KF.FormAddStrParameter( s ); + end; + + if (StandardImagesUsed = 0) and (PicturedButtonsCount = 0) and not ImageListsUsed then + begin + KF.FormAddNumParameter( 1 ); + KF.FormAddNumParameter( -2 ); + end else + if (StandardImagesUsed = 0) and AllPicturedButtonsAreLeading and + LastBtnHasPicture and not ImageListsUsed then + begin + KF.FormAddNumParameter( 1 ); + KF.FormAddNumParameter( 0 ); + end else + begin + N := PicturedButtonsCount; + StdImagesStart := N; + ViewImagesStart := N; + HistImagesStart := N; + if (StandardImagesUsed > 1) and LongBool(StandardImagesUsed and 1) then + begin + ViewImagesStart := N + 15; + HistImagesStart := N + 15; + end; + if LongBool(StandardImagesUsed and 2) then + HistImagesStart := HistImagesStart + 12; + N := 0; + S := ''; + KF.FormAddNumParameter( Items.Count ); + for I := 0 to Items.Count-1 do + begin + Bt := Items[ I ]; + if ImageListsUsed then + begin + if Bt.imgIndex >= 0 then + KF.FormAddNumParameter( Bt.imgIndex ) + else + KF.FormAddNumParameter( -2 ); + end + else + if Bt.HasPicture then + begin + KF.FormAddNumParameter( N ); + Inc( N ); + end + else + case Bt.sysimg of + stiCustom: + KF.FormAddNumParameter( -2 ); // I_IMAGENONE + stdCUT..stdPRINT: + KF.FormAddNumParameter( StdImagesStart + Ord( Bt.sysimg ) - Ord( stdCUT ) ); + viewLARGEICONS..viewVIEWMENU: + KF.FormAddNumParameter( ViewImagesStart + Ord( Bt.sysimg ) - Ord( viewLARGEICONS ) ); + else + KF.FormAddNumParameter( HistImagesStart + Ord( Bt.sysimg ) - Ord( histBACK ) ); + end; + end; + end; +end; + +function TKOLToolbar.SupportsFormCompact: Boolean; +begin + Result := TRUE; //CompactCode; +end; + +procedure TKOLToolbar.SetCompactCode(const Value: Boolean); +begin + if FCompactCode = Value then Exit; + FCompactCode := Value; + Change; +end; + +function TKOLToolbar.HasCompactConstructor: Boolean; +begin + Result := CompactCode and (Items.Count < 256); +end; + +function TKOLToolbar.ButtonCaptionsList( var Cnt: Integer ): String; +VAR S, B: String; + I: Integer; + Bt, Bt1: TKOLToolbarButton; + TheSameBefore, TheSameAfter: Boolean; + {$IFDEF _D2009orHigher} + C2: String; + C : String; + Z: Integer; + {$ENDIF} +begin + Result := ''; + Cnt := 0; + for I := 0 to Items.Count-1 do + begin + Bt := Items[ I ]; + if Bt.separator then + begin + Result := Result + '''-'''; + end + else + begin + if noTextLabels then + B := ' ' + else + begin + {$IFDEF _D2009orHigher} + C2 := ''; + C := Bt.Fcaption; + for Z := 1 to Length(C) do C2 := C2 + '#'+int2str(ord(C[Z])); + B := C2; + {$ELSE} + B := Bt.Fcaption; + {$ENDIF} + end; + S := ''; + if Bt.radioGroup <> 0 then + begin + TheSameBefore := FALSE; + TheSameAfter := FALSE; + if I > 0 then + begin + Bt1 := Items[ I - 1 ]; + if not Bt1.separator and (Bt1.FradioGroup = Bt.FradioGroup) then + TheSameBefore := TRUE; + end; + if I < Items.Count-1 then + begin + Bt1 := Items[ I + 1 ]; + if not Bt1.separator and (Bt1.FradioGroup = Bt.FradioGroup) then + TheSameAfter := TRUE; + end; + if TheSameBefore or TheSameAfter then + S := '!' + S; + end; + if Bt.checked and (Bt.Faction = nil) then + S := '+' + S + else + if Bt.radioGroup <> 0 then + S := '-' + S; + if Bt.dropdown then + S := '^' + S; + if noTextLabels then + Result := Result + '''' + S + B + '''' + else + if Bt.Faction <> nil then + Result := Result + '''' + S + ' ''' + else + begin + {$IFDEF _D2009orHigher} + if B = '' then B := ''''''; + {$ELSE} + B := StringConstant( Bt.Name + '_btn', B ); + {$ENDIF} + if (B <> '') and (B[ 1 ] = '''') then + Result := Result + '''' + S + Copy( B, 2, MaxInt ) + else + if S <> '' then + Result := Result + 'PKOLChar( ''' + S + ''' + ' + B + ')' + else + Result := Result + 'PKOLChar( ' + B + ' )'; + end; + end; + if I < Items.Count-1 then + Result := Result + ', '; + inc( Cnt ); + end; +end; + +function TKOLToolbar.ButtonImgIndexesList( var Cnt: Integer ): String; +VAR I, N: Integer; + StdImagesStart, ViewImagesStart, HistImagesStart: Integer; + S: String; + Bt: TKOLToolbarButton; +begin + Cnt := 0; + if (StandardImagesUsed = 0) and (PicturedButtonsCount = 0) and not ImageListsUsed then + begin + Result := Result + '-2'; + Cnt := 1; + end else + if (StandardImagesUsed = 0) and AllPicturedButtonsAreLeading and + LastBtnHasPicture and not ImageListsUsed then + begin + Result := Result + '0'; + Cnt := 1; + end else + begin + N := PicturedButtonsCount; + StdImagesStart := N; + ViewImagesStart := N; + HistImagesStart := N; + if (StandardImagesUsed > 1) and LongBool(StandardImagesUsed and 1) then + begin + ViewImagesStart := N + 15; + HistImagesStart := N + 15; + end; + if LongBool(StandardImagesUsed and 2) then + HistImagesStart := HistImagesStart + 12; + N := 0; + S := ''; + for I := 0 to Items.Count-1 do + begin + Bt := Items[ I ]; + //Rpt( '%%%%%%%%%% Bt ' + Bt.Name + ' HasPicture := ' + IntToStr( Integer( Bt.HasPicture ) ) ); + if ImageListsUsed then + begin + if Bt.imgIndex >= 0 then + S := IntToStr( Bt.imgIndex ) + else + S := '-2'; + end + else + if Bt.HasPicture then + begin + S := IntToStr( N ); + Inc( N ); + end + else + case Bt.sysimg of + stiCustom: + S := '-2'; // I_IMAGENONE + stdCUT..stdPRINT: + S := IntToStr( StdImagesStart + Ord( Bt.sysimg ) - Ord( stdCUT ) ); + viewLARGEICONS..viewVIEWMENU: + S := IntToStr( ViewImagesStart + Ord( Bt.sysimg ) - Ord( viewLARGEICONS ) ); + else + S := IntToStr( HistImagesStart + Ord( Bt.sysimg ) - Ord( histBACK ) ); + end; + Result := Result + S + ', '; + inc( Cnt ); + end; + if Items.Count > 0 then + Result := Copy( Result, 1, Length( Result ) - 2 ); + end; +end; + +procedure TKOLToolbar.SetAutosizeButtons(const Value: Boolean); +begin + if FAutosizeButtons = Value then Exit; + FAutosizeButtons := Value; + Change; +end; + +procedure TKOLToolbar.SetNoSpaceForImages(const Value: Boolean); +begin + if FNoSpaceForImages = Value then Exit; + FNoSpaceForImages := Value; + Change; +end; + { TKOLToolbarButtonsEditor } procedure TKOLToolbarButtonsEditor.Edit; @@ -13002,8 +14629,22 @@ begin Invalidate; end; +procedure TKOLLabelEffect.SetupConstruct_Compact; +var KF: TKOLForm; +begin + ////inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddCtlParameter( Name ); + KF.FormCurrentCtlForTransparentCalls := Name; + KF.FormAddAlphabet( 'FormNewLabelEffect', TRUE, TRUE ); + KF.FormAddStrParameter( Caption ); + KF.FormAddNumParameter( ShadowDeep ); +end; + procedure TKOLLabelEffect.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -13012,10 +14653,22 @@ begin @@e_signature: end; inherited; - if Color2 <> clNone then - SL.Add( Prefix + AName + '.Color2 := ' + Color2Str( Color2 ) + ';' ); - if Ctl3D then - SL.Add( Prefix + AName + '.Ctl3D := TRUE;' ); + KF := ParentKOLForm; + if Color2 <> clNone then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetColor2' ); + KF.FormAddNumParameter( (Color2 shl 1) or (Color2 shr 31) ); + end else + SL.Add( Prefix + AName + '.Color2 := TColor(' + Color2Str( Color2 ) + ');' ); + + if Ctl3D then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetCtl3D' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.Ctl3D := TRUE;' ); end; function TKOLLabelEffect.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -13047,6 +14700,7 @@ end; procedure TKOLLabelEffect.SetupTextAlign(SL: TStrings; const AName: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -13054,10 +14708,22 @@ begin DB 'TKOLLabelEffect.SetupTextAlign', 0 @@e_signature: end; - if TextAlign <> taCenter then - SL.Add( ' ' + AName + '.TextAlign := KOL.' + TextAligns[ TextAlign ] + ';' ); - if VerticalAlign <> vaTop then - SL.Add( ' ' + AName + '.VerticalAlign := KOL.' + VertAligns[ VerticalAlign ] + ';' ); + KF := ParentKOLForm; + if TextAlign <> taCenter then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetTextAlign' ); + KF.FormAddNumParameter( Integer( TextAlign ) ); + end else + SL.Add( ' ' + AName + '.TextAlign := KOL.' + TextAligns[ TextAlign ] + ';' ); + + if VerticalAlign <> vaTop then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetTextVAlign' ); + KF.FormAddNumParameter( Integer( VerticalAlign ) ); + end else + SL.Add( ' ' + AName + '.VerticalAlign := KOL.' + VertAligns[ VerticalAlign ] + ';' ); end; procedure TKOLLabelEffect.SetWindowed(const Value: Boolean); @@ -13065,6 +14731,11 @@ begin inherited SetWindowed( TRUE ); end; +function TKOLLabelEffect.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + { TKOLScrollBox } constructor TKOLScrollBox.Create(AOwner: TComponent); @@ -13185,6 +14856,27 @@ begin Change; end; +procedure TKOLScrollBox.SetupConstruct_Compact; +var KF: TKOLForm; + i: Integer; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNew' + TypeName, TRUE, TRUE ); + KF.FormAddNumParameter( Integer( EdgeStyle ) ); + if TypeName = 'ScrollBox' then + begin + CASE ScrollBars OF + ssNone: i := 0; + ssHorz: i := 1; + ssVert: i := 2; + else i := 3; + END; + KF.FormAddNumParameter( i ); + end; +end; + function TKOLScrollBox.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; const EdgeStyles: array[ TEdgeStyle ] of String = ( 'esRaised', 'esLowered', 'esNone', 'esTransparent', 'esSolid' ); @@ -13209,6 +14901,11 @@ begin end; end; +function TKOLScrollBox.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLScrollBox.TypeName: String; begin asm @@ -13218,8 +14915,8 @@ begin @@e_signature: end; Result := inherited TypeName; - if IsControlContainer then - Result := 'ScrollBoxEx'; + if IsControlContainer then + Result := 'ScrollBoxEx'; end; { TKOLMDIClient } @@ -14598,11 +16295,8 @@ begin Height := 24; DefaultHeight := Height; Color := clWindow; fTabStop := TRUE; -end; - -function TKOLDateTimePicker.GenerateTransparentInits: String; -begin - Result := inherited GenerateTransparentInits; + MonthBkColor := clNone; + MonthTxtColor := clNone; end; function TKOLDateTimePicker.Pcode_Generate: Boolean; @@ -14620,11 +16314,6 @@ begin [ FALSE ], CheckOnly ); end; -function TKOLDateTimePicker.P_GenerateTransparentInits: String; -begin - Result := inherited P_GenerateTransparentInits; -end; - procedure TKOLDateTimePicker.P_SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); begin @@ -14664,6 +16353,20 @@ begin Change; end; +procedure TKOLDateTimePicker.SetMonthBkColor(const Value: TColor); +begin + if FMonthBkColor = Value then Exit; + FMonthBkColor := Value; + Change; +end; + +procedure TKOLDateTimePicker.SetMonthTxtColor(const Value: TColor); +begin + if FMonthTxtColor = Value then Exit; + FMonthTxtColor := Value; + Change; +end; + procedure TKOLDateTimePicker.SetOnDTPUserString(const Value: KOL.TDTParseInputEvent); begin FOnDTPUserString := Value; @@ -14680,16 +16383,51 @@ begin Change; end; +procedure TKOLDateTimePicker.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewDateTimePicker', TRUE, TRUE ); + KF.FormAddNumParameter( PByte( @ Options )^ ); +end; + procedure TKOLDateTimePicker.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin inherited; - if Format <> '' then - SL.Add( Prefix + AName + '.DateTimeFormat := ' + - StringConstant( 'Format', Format ) + ';' ); - if not ParentColor then - SL.Add( Prefix + AName + '.DateTimePickerColors[ dtpcBackground ] := ' + - Color2Str( Color ) + ';' ); + KF := ParentKOLForm; + if Format <> '' then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetDateTimeFormat' ); + KF.FormAddStrParameter( Format ); + end else + SL.Add( Prefix + AName + '.DateTimeFormat := ' + + StringConstant( 'Format', Format ) + ';' ); + + if MonthBkColor <> clNone then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetDateTimeColor' ); + KF.FormAddNumParameter( (MonthBkColor shl 1) or (MonthBkColor shr 31) ); + KF.FormAddNumParameter( Integer( dtpcBackground ) ); + end else + SL.Add( Prefix + AName + '.DateTimePickerColors[ dtpcBackground ] := TColor(' + + Color2Str( MonthBkColor ) + ');' ); + + if MonthTxtColor <> clNone then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetDateTimeColor' ); + KF.FormAddNumParameter( (MonthTxtColor shl 1) or (MonthTxtColor shr 31) ); + KF.FormAddNumParameter( Integer( dtpcText ) ); + end else + SL.Add( Prefix + AName + '.DateTimePickerColors[ dtpcMonthBk ] := TColor(' + + Color2Str( MonthTxtColor ) + ');' ); + end; function TKOLDateTimePicker.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -14706,6 +16444,11 @@ begin Result := AParent + ', [' + S + ']'; end; +function TKOLDateTimePicker.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + function TKOLDateTimePicker.TabStopByDefault: Boolean; begin Result := TRUE; @@ -14880,8 +16623,19 @@ begin Change; end; +procedure TKOLScrollBar.SetupConstruct_Compact; +var KF: TKOLForm; +begin + inherited; + KF := ParentKOLForm; + if KF = nil then Exit; + KF.FormAddAlphabet( 'FormNewScrollBar', TRUE, TRUE ); + KF.FormAddNumParameter( Integer( SBBar ) ); +end; + procedure TKOLScrollBar.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -14890,14 +16644,37 @@ begin @@e_signature: end; inherited; - if SBMin <> 0 then - SL.Add( Prefix + AName + '.SBMin := ' + IntToStr( SBMin ) + ';' ); - //if SBMax <> 100 then - SL.Add( Prefix + AName + '.SBMax := ' + IntToStr( SBMax ) + ';' ); - if SBPosition <> SBMin then - SL.Add( Prefix + AName + '.SBPosition := ' + IntToStr( SBPosition ) + ';' ); - if SBPageSize <> 0 then - SL.Add( Prefix + AName + '.SBPageSize := ' + IntToStr( SBPageSize ) + ';' ); + KF := ParentKOLForm; + if SBMin <> 0 then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetSBMin' ); + KF.FormAddNumParameter( SBMin ); + end else + SL.Add( Prefix + AName + '.SBMin := ' + IntToStr( SBMin ) + ';' ); + + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetSBMax' ); + KF.FormAddNumParameter( SBMax ); + end else + SL.Add( Prefix + AName + '.SBMax := ' + IntToStr( SBMax ) + ';' ); + + if SBPosition <> SBMin then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetSBPosition' ); + KF.FormAddNumParameter( SBPosition ); + end else + SL.Add( Prefix + AName + '.SBPosition := ' + IntToStr( SBPosition ) + ';' ); + + if SBPageSize <> 0 then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetSBPageSize' ); + KF.FormAddNumParameter( SBPageSize ); + end else + SL.Add( Prefix + AName + '.SBPageSize := ' + IntToStr( SBPageSize ) + ';' ); end; function TKOLScrollBar.SetupParams( const AName, AParent: TDelphiString ): TDelphiString; @@ -14913,6 +16690,18 @@ begin Result := AParent + ', ' + ScrollerbarNames[ SBBar ]; end; +function TKOLScrollBar.SupportsFormCompact: Boolean; +begin + Result := TRUE; +end; + +{ TKOLTabPage } + +function TKOLTabPage.TypeName: String; +begin + Result := 'Panel'; +end; + end. diff --git a/mckObjs.pas b/mckObjs.pas index 272dd2c..492bc94 100644 --- a/mckObjs.pas +++ b/mckObjs.pas @@ -367,7 +367,7 @@ function CountSystemColorsUsedInBitmap( Bmp: KOL.PBitmap ): KOLTPixelFormat; //function SaveBitmap( Bitmap: TBitmap; const Path: String ): Boolean; procedure GenerateBitmapResource( Bitmap: TBitmap; const RsrcName, FileName: String; var Updated: Boolean ); -procedure GenerateIconResource( Icon: TIcon; const RsrcName, FileName: String; +procedure GenerateIconResource( Icon: TIcon; const RsrcName, FileName: KOLString; var Updated: Boolean ); procedure RemoveSelection( FD: IFormDesigner ); function String2Pascal( S: String; const Concatenator: String ): String; @@ -395,8 +395,9 @@ var I, Strt : Integer; function String2DoubleQuotas( const S : String ) : String; var I, J : Integer; begin - if IndexOfChar( S, '''' ) <= 0 then - Result := S + //if IndexOfChar( S, '''' ) <= 0 then + if pos( '''', S ) <= 0 then + Result := S else begin J := 0; @@ -440,10 +441,10 @@ begin else Result := Result + '''''' + Concatenator; // Result := Result + ''''''; - if pos( ',', Concatenator ) > 0 then - Result := Result + Int2Str( Integer( S[ I ] ) ) - else - Result := Result + '#' + Int2Str( Integer( S[ I ] ) ); + //if IndexOfChar(Concatenator, ',') > 0 then + if pos( ',', Concatenator ) > 0 then + Result := Result + IntToStr( Integer( S[ I ] ) ) + else Result := Result + '#' + IntToStr( Integer( S[ I ] ) ); Strt := I + 1; end; end; @@ -544,7 +545,7 @@ begin end; if not Found then begin - Rpt( '***** Color ' + Int2Hex( C, 8 ) + ' not found in system 16 colors', + Rpt( '***** Color ' + IntToHex( C, 8 ) + ' not found in system 16 colors', WHITE ); Result := FALSE; Exit; @@ -818,7 +819,8 @@ var br, hFR, hFtm, DIBLen, WLen, RLen, tm: DWORD; Buf1, Buf2: PByteArray; FE: boolean; - Res, Bmp: string; + Res: String; + Bmp: String; tmStr: WideString; KOLBmp: KOL.PBitmap; @@ -949,10 +951,10 @@ begin end; end; -procedure GenerateIconResource( Icon: TIcon; const RsrcName, FileName: String; +procedure GenerateIconResource( Icon: TIcon; const RsrcName, FileName: KOLString; var Updated: Boolean ); var RL: TStringList; - Buf1, Buf2: PChar; + Buf1, Buf2: PKOLChar; S: String; I, J: Integer; F: THandle; @@ -968,7 +970,7 @@ begin if not SaveIcon( Icon, ProjectSourcePath + FileName + '.ico' ) then Exit; RL := TStringList.Create; - RL.Add( UpperCase( RsrcName ) + ' ICON "' + FileName + '.ico"' ); + RL.Add( KOLUpperCase( RsrcName ) + ' ICON "' + FileName + '.ico"' ); RL.SaveToFile( ProjectSourcePath + FileName + '.rc' ); RL.Free; Buf1 := nil; @@ -2227,7 +2229,7 @@ begin C := StringConstant( 'Title', Title ); {$IFDEF _D2009orHigher} C2 := ''; - for i := 2 to Length(C) - 1 do C2 := C2 + '#'+int2str(ord(C[i])); + for i := 2 to Length(C) - 1 do C2 := C2 + '#'+IntToStr(ord(C[i])); C := C2; {$ENDIF} if C = '' then C := ''''''; @@ -2579,7 +2581,7 @@ begin C := StringConstant( 'Title', Title ); {$IFDEF _D2009orHigher} C2 := ''; - for i := 2 to Length(C) - 1 do C2 := C2 + '#'+int2str(ord(C[i])); + for i := 2 to Length(C) - 1 do C2 := C2 + '#'+IntToStr(ord(C[i])); C := C2; {$ENDIF} if C = '' then C := ''''''; @@ -2591,7 +2593,7 @@ begin C := StringConstant( 'Title', Title ); {$IFDEF _D2009orHigher} C2 := ''; - for i := 2 to Length(C) - 1 do C2 := C2 + '#'+int2str(ord(C[i])); + for i := 2 to Length(C) - 1 do C2 := C2 + '#'+IntToStr(ord(C[i])); C := C2; {$ENDIF} if C = '' then C := ''''''; @@ -2804,7 +2806,7 @@ end; procedure TKOLTrayIcon.P_SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); -var RsrcName, RsrcFile: String; +var RsrcName, RsrcFile: KOLString; begin asm jmp @@e_signature @@ -2993,7 +2995,7 @@ begin C := StringConstant( 'Tooltip', Tooltip ); {$IFDEF _D2009orHigher} C2 := ''; - for i := 2 to Length(C) - 1 do C2 := C2 + '#'+int2str(ord(C[i])); + for i := 2 to Length(C) - 1 do C2 := C2 + '#'+IntToStr(ord(C[i])); C := C2; {$ENDIF} if C = '' then C := ''''''; diff --git a/mirror.pas b/mirror.pas index a708869..faeca7e 100644 --- a/mirror.pas +++ b/mirror.pas @@ -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 2.89 +* VERSION 3.00.F ******************************************************** } unit mirror; @@ -29,7 +29,7 @@ unit mirror; by Vladimir Kladov, 27.11.2000, 13.10.2006 В данном модуле определяются зеркальные классы для объектов библиотеки KOL. - Цель - создать средство для визуального проектирования проектов KOL. + Цель - создать средство для визуального конструирования форм в проектах KOL. Кладов Владимир, 27.11.2000, 13.10.2006 } @@ -177,7 +177,15 @@ type - + TFormStringList = class( TStringList ) + private + FCallingOnAdd: Boolean; + FOnAdd: TNotifyEvent; + procedure SetOnAdd(const Value: TNotifyEvent); + public + property OnAdd: TNotifyEvent read FOnAdd write SetOnAdd; + function Add( const s: String ): Integer; override; + end; @@ -208,15 +216,15 @@ type // при генерации кода dpr-файла. TKOLProject = class( TComponent ) private - fProjectName: AnsiString; - FProjectDest: AnsiString; + fProjectName: String; + FProjectDest: String; fSourcePath: TFileName; fDprResource: Boolean; fProtect: Boolean; fShowReport: Boolean; fBuild: Boolean; fIsKOL: Integer; - fOutdcuPath: AnsiString; + fOutdcuPath: String; fAutoBuild: Boolean; fTimer: TTimer; fAutoBuilding: Boolean; @@ -228,16 +236,16 @@ type fChangingNow: Boolean; FSupportAnsiMnemonics: LCID; FPaintType: TPaintType; - FHelpFile: AnsiString; + FHelpFile: String; FLocalizy: Boolean; FShowHint: Boolean; FIsDestroying: Boolean; - FCallPCompiler: AnsiString; + FCallPCompiler: String; FReportDetailed: Boolean; FGeneratePCode: Boolean; FDefaultFont: TKOLFont; - function GetProjectName: AnsiString; - procedure SetProjectDest(const Value: AnsiString); + function GetProjectName: String; + procedure SetProjectDest(const Value: String); function ConvertVCL2KOL( ConfirmOK: Boolean; ForceAllForms: Boolean ): Boolean; function OwnerKOLForm: TKOLForm; @@ -247,7 +255,7 @@ type {$ENDIF} function UpdateConfig: Boolean; function GetSourcePath: TFileName; - function GetProjectDest: AnsiString; + function GetProjectDest: String; function GetBuild: Boolean; procedure SetBuild(const Value: Boolean); function GetIsKOLProject: Boolean; @@ -261,10 +269,10 @@ type procedure SetLocked(const Value: Boolean); procedure SetSupportAnsiMnemonics(const Value: LCID); procedure SetPaintType(const Value: TPaintType); - procedure SetHelpFile(const Value: AnsiString); + procedure SetHelpFile(const Value: String); procedure SetLocalizy(const Value: Boolean); procedure SetShowHint(const Value: Boolean); - procedure SetCallPCompiler(const Value: AnsiString); + procedure SetCallPCompiler(const Value: String); procedure SetReportDetailed(const Value: Boolean); procedure SetGeneratePCode(const Value: Boolean); function getNewIf: Boolean; @@ -304,13 +312,13 @@ type // // Имя проекта (зеркального, т.е. исходного). Определяется просто - по // заголовку окна Delphi IDE. Можно изменить руками. - property projectName: AnsiString read GetProjectName write fProjectName; + property projectName: String read GetProjectName write fProjectName; // Project name for converted (KOL) project. Must be entered manually, // and it must not much project name. // Имя проекта после конверсии в KOL. Требуется ввести руками. // Ни в коем случае не должен совпадать с именем самого проекта. - property projectDest: AnsiString read GetProjectDest write SetProjectDest; + property projectDest: String read GetProjectDest write SetProjectDest; // Path to source (=mirror) project. When TKOLProject component is // dropped onto form, a dialog is appear to select path to a directory @@ -363,12 +371,12 @@ type property PaintType: TPaintType read FPaintType write SetPaintType; - property HelpFile: AnsiString read FHelpFile write SetHelpFile; + property HelpFile: String read FHelpFile write SetHelpFile; property ShowHint: Boolean read FShowHint write SetShowHint; {* To provide tooltip (hint) showing, it is necessary to define conditional symbol USE_MHTOOLTIP in Project|Options|Directories/Conditionals|Conditional Defines. } - property CallPCompiler: AnsiString read FCallPCompiler write SetCallPCompiler; + property CallPCompiler: String read FCallPCompiler write SetCallPCompiler; property ReportDetailed: Boolean read FReportDetailed write SetReportDetailed; property GeneratePCode: Boolean read FGeneratePCode write SetGeneratePCode; property NewIF: Boolean read getNewIf write setNewIf; @@ -556,12 +564,17 @@ type function P_AssignEvents( SL: TStringList; const AName: String; CheckOnly: Boolean ): Boolean; virtual; + protected + FEventDefs: TStringList; + FAssignOnlyUserEvents: Boolean; + FAssignOnlyWinEvents: Boolean; + public + procedure DefineFormEvents( const EventNamesAndDefs: array of String ); procedure DoAssignEvents( SL: TStringList; const AName: String; - EventNames: array of PAnsiChar; EventHandlers: array of Pointer ); + EventNames: array of PChar; EventHandlers: array of Pointer ); function P_DoAssignEvents( SL: TStringList; const AName: String; EventNames: array of PAnsiChar; EventHandlers: array of Pointer; EventAssignProc: array of Boolean; CheckOnly: Boolean ): Boolean; - function BestEventName: String; virtual; public procedure Change( Sender: TComponent ); virtual; @@ -745,9 +758,13 @@ type FOnBeforeCreateWindow: TOnEvent; {YS} FKeyPreview: Boolean; FFontDefault: Boolean; - function GetFormUnit: String; + FFormCompact: Boolean; + FGenerateCtlNames: Boolean; + FUnicode: Boolean; + FOverrideScrollbars: Boolean; + function GetFormUnit: KOLString; procedure SetFormMain(const Value: Boolean); - procedure SetFormUnit(const Value: String); + procedure SetFormUnit(const Value: KOLString); function GetFormMain: Boolean; function GetSelf: TKOLForm; @@ -832,6 +849,11 @@ type procedure SetOnBeforeCreateWindow(const Value: TOnEvent); {YS} procedure SetKeyPreview(const Value: Boolean); procedure SetFontDefault(const Value: Boolean); + procedure SetFormCompact(const Value: Boolean); + procedure SetGenerateCtlNames(const Value: Boolean); + procedure SetUnicode(const Value: Boolean); + procedure SetOverrideScrollbars(const Value: Boolean); + procedure Set_Bounds(const Value: TFormBounds); protected fUniqueID: Integer; FLocked: Boolean; @@ -841,8 +863,8 @@ type function GetCaption: TDelphiString; virtual; procedure SetFormCaption(const Value: TDelphiString); virtual; - function GetFormName: String; - procedure SetFormName(const Value: String); + function GetFormName: KOLString; + procedure SetFormName(const Value: KOLString); function GenerateTransparentInits: String; virtual; function P_GenerateTransparentInits: String; virtual; function Result_Form: String; virtual; @@ -918,6 +940,7 @@ type procedure RealignTimerTick( Sender: TObject ); procedure ChangeTimerTick( Sender: TObject ); + public function BestEventName: String; override; protected fCreating: Boolean; @@ -970,11 +993,11 @@ type // переменной формы типа P в сгенерированном модуле для KOL-проекта. // Эта переменная не есть точное соответствие форме, но содержит переменую // Form: PControl, в действительности соответствующую ей. - property formName: String read GetFormName write SetFormName stored False; + property formName: KOLString read GetFormName write SetFormName stored False; // Unit name, containing form definition. // Имя модуля, в котором содержится форма. - property formUnit: String read GetFormUnit write SetFormUnit; + property formUnit: KOLString read GetFormUnit write SetFormUnit; // Form is marked 'main', if it contain also TKOLProject component. // (Main form in KOL playes special role, and can even replace @@ -991,7 +1014,7 @@ type property Visible; property Enabled; - property bounds: TFormBounds read fBounds; + property bounds: TFormBounds read fBounds write Set_Bounds; property defaultSize: Boolean read fDefaultSize write SetDefaultSize; property defaultPosition: Boolean read fDefaultPos write SetDefaultPos; property MinWidth: Integer read FMinWidth write SetMinWidth; @@ -1090,6 +1113,35 @@ type property OnHelp: TOnHelp read FOnHelp write SetOnHelp; property OnBeforeCreateWindow: TOnEvent read FOnBeforeCreateWindow write SetOnBeforeCreateWindow; + protected + FFormAlphabet: TStringList; + FFormCommandsAndParams: String; + FFormCtlParams: TStringList; + public + FormCurrentCtlForTransparentCalls: String; + FormCurrentParent: String; + FormCurrentParentCtl: TKOLCustomControl; + FormIndexFlush: Integer; + FormFlushedUntil: Integer; + FormFunArrayIdx: Integer; + FormControlsList: TStringList; + IsFormFlushing: Boolean; + function FormIndexOfControl( const CtlName: String ): Integer; + function EncodeFormNumParameter( I: Integer ): String; + function FormAddAlphabet( const funname: String; creates_ctrl, add_call: Boolean ): Integer; + procedure FormAddCtlCommand( const CtlName, FunName: String ); + procedure FormAddNumParameter( N: Integer ); + procedure FormAddStrParameter( const S: String ); + procedure FormAddCtlParameter( const S: String ); + procedure FormFlushCompact( SL: TFormStringList ); + function FormFlushedCompact: Boolean; + procedure DoFlushFormCompact( Sender: TObject ); + procedure GenerateTransparentInits_Compact; virtual; + published + property FormCompact: Boolean read FFormCompact write SetFormCompact; + property GenerateCtlNames: Boolean read FGenerateCtlNames write SetGenerateCtlNames; + property Unicode: Boolean read FUnicode write SetUnicode; + property OverrideScrollbars: Boolean read FOverrideScrollbars write SetOverrideScrollbars; end; @@ -1868,7 +1920,6 @@ type FCancelBtn: Boolean; FIsGenerateSize: Boolean; FIsGeneratePosition: Boolean; - FUnicode: Boolean; Faction: TKOLAction; FWindowed: Boolean; FAnchorTop: Boolean; //+Sormart @@ -1984,7 +2035,6 @@ type procedure SetBrush(const Value: TKOLBrush); procedure SetIsGenerateSize(const Value: Boolean); procedure SetIsGeneratePosition(const Value: Boolean); - procedure SetUnicode(const Value: Boolean); procedure Setaction(const Value: TKOLAction); procedure SetAnchorLeft(const Value: Boolean); //+Sormart procedure SetAnchorTop(const Value: Boolean); //+Sormart @@ -2194,11 +2244,16 @@ type procedure AssignEvents( SL: TStringList; const AName: String ); virtual; function P_AssignEvents( SL: TStringList; const AName: String; CheckOnly: Boolean ): Boolean; virtual; - + protected + FEventDefs: TStringList; + FAssignOnlyUserEvents: Boolean; + FAssignOnlyWinEvents: Boolean; + public + procedure DefineFormEvents( const EventNamesAndDefs: array of String ); procedure DoAssignEvents( SL: TStringList; const AName: String; - const EventNames: array of PAnsiChar; const EventHandlers: array of Pointer ); + const EventNames: array of PChar; const EventHandlers: array of Pointer ); function P_DoAssignEvents( SL: TStringList; const AName: String; - const EventNames: array of PAnsiChar; const EventHandlers: array of Pointer; + const EventNames: array of PChar; const EventHandlers: array of Pointer; const EventAssignProc: array of Boolean; CheckOnly: Boolean ): Boolean; // This method allows to initializy part of properties as a sequence @@ -2428,7 +2483,6 @@ type property Localizy: TLocalizyOptions read FLocalizy write SetLocalizy; property DefaultBtn: Boolean read FDefaultBtn write SetDefaultBtn; property CancelBtn: Boolean read FCancelBtn write SetCancelBtn; - property Unicode: Boolean read FUnicode write SetUnicode; property action: TKOLAction read Faction write Setaction stored False; property Windowed: Boolean read GetWindowed write SetWindowed; property popupMenu: TKOLPopupMenu read FpopupMenu write SetpopupMenu; @@ -2443,6 +2497,14 @@ type property AnchorBottom: Boolean read FAnchorBottom write SetAnchorBottom; property AcceptChildren: Boolean read FAcceptChildren write SetAcceptChildren; property MouseTransparent: Boolean read FMouseTransparent write SetMouseTransparent; + protected + function SupportsFormCompact: Boolean; virtual; + function HasCompactConstructor: Boolean; virtual; + procedure SetupConstruct_Compact; virtual; + procedure GenerateTransparentInits_Compact; virtual; + procedure Generate_SetSize_Compact; virtual; + procedure GenerateVerticalAlign( SL: TStrings; const AName: String ); + procedure GenerateTextAlign( SL: TStrings; const AName: String ); end; TKOLControl = class( TKOLCustomControl ) @@ -2951,6 +3013,9 @@ procedure MarkModified( const Path: String ); const Signature = '{ KOL MCK } // Do not remove this line!'; +const TextAligns: array[ TTextAlign ] of String = ( 'taLeft', 'taRight', 'taCenter' ); + VertAligns: array[ TVerticalAlign ] of String = ( 'vaTop', 'vaCenter', 'vaBottom' ); + procedure Register; @@ -3013,6 +3078,26 @@ begin Result := Copy( s, 8, Length( s ) - 7 ); end; +function IDI2Number( const IDIName: String ): Integer; +const + IDINames: array[ 1..9 ] of String = ( + 'IDI_APPLICATION', 'IDI_HAND', 'IDI_QUESTION', 'IDI_EXCLAMATION', + 'IDI_ASTERISK', 'IDI_WINLOGO', 'IDI_WARNING', 'IDI_ERROR', + 'IDI_INFORMATION' ); + IDIValues: array[ 1..9 ] of Integer = ( 32512, 32513, 32514, 32515, + 32516, 32517, + 32515, 32513, 32516 ); +var i: Integer; +begin + for i := 1 to High( IDINames ) do + if UpperCase( IDIName ) = IDINames[ i ] then + begin + Result := IDIValues[ i ]; + Exit; + end; + Result := 0; +end; + function IDC2Number( const IDCName: String ): Integer; const IDCNames: array[ 1..16 ] of String = ( @@ -3035,7 +3120,7 @@ end; {$STACKFRAMES ON} function GetCallStack: TStringList; var RegEBP: PDWORD; - RetAddr, MinSearchAddr, SrchPtr: PAnsiChar; + RetAddr, MinSearchAddr, SrchPtr: PChar; Found: Boolean; begin Result := TStringList.Create; @@ -3074,7 +3159,7 @@ begin end; if not Found then break; Inc( SrchPtr, Length( '#$signature$#' ) + 1 ); - Result.Add( AnsiString(SrchPtr) ); // TODO: cast + Result.Add( String(SrchPtr) ); // TODO: cast Dec( RegEBP ); try RegEBP := Pointer( RegEBP^ ); @@ -3352,7 +3437,7 @@ begin {$ENDIF} end; -function ReadTextFromIDE( Reader: TIEditReader ): PAnsiChar; +function ReadTextFromIDE( Reader: TIEditReader ): PChar; var Buf: PChar; // ANSI_CTRLS? Len, Pos: Integer; MS: TMemoryStream; @@ -3398,7 +3483,7 @@ end; {$IFNDEF VER90} {$IFNDEF VER100} -function ReadTextFromIDE_0( Reader: IOTAEditReader ): PAnsiChar; +function ReadTextFromIDE_0( Reader: IOTAEditReader ): PChar; var Buf: PAnsiChar; Len, Pos: Integer; MS: TMemoryStream; @@ -3451,7 +3536,7 @@ var N, I: Integer; Module: TIModuleInterface; Editor: TIEditorInterface; Reader: TIEditReader; - Buffer: PAnsiChar; + Buffer: PChar; {$IFNDEF VER90} {$IFNDEF VER100} @@ -3497,7 +3582,7 @@ begin Buffer := ReadTextFromIDE( Reader ); if Buffer <> nil then begin - SL.Text := AnsiString(Buffer); // TODO: KOL_ANSI + SL.Text := String(Buffer); // TODO: KOL_ANSI Loaded := True; //Rpt( 'Loaded: ' + Path ); end; @@ -3537,7 +3622,7 @@ begin Buffer := ReadTextFromIDE_0( ER ); if Buffer <> nil then begin - SL.Text := AnsiString(Buffer); // TODO: KOL_ANSI + SL.Text := String(Buffer); // TODO: KOL_ANSI Loaded := True; //Rpt( 'Loaded_0: ' + Path ); end; @@ -3712,16 +3797,16 @@ begin while I < Old.Count do begin s := Old[ I ]; - if StrIsStartingFrom( PAnsiChar( AnsiString(s) ), ' PROC(2) //--by PCompiler:line#' ) then // TODO: dangerous + if StrIsStartingFrom( PChar( s ), ' PROC(2) //--by PCompiler:line#' ) then // TODO: dangerous Old[ I ] := ' PROC(2)' else - if StrEq( s, '{$ENDIF Psource}' ) then + if AnsiCompareText( s, '{$ENDIF Psource}' ) = 0 then begin Inc( I ); while I < Old.Count do begin s := Old[ I ]; - if StrEq( s, '{$ELSE OldCode}' ) then break; + if AnsiCompareText( s, '{$ELSE OldCode}' ) = 0 then break; Old.Delete( I ); end; end; @@ -4608,6 +4693,72 @@ begin end; Log( '->TKOLCustomControl.AssignEvents' ); try + Rpt( 'Calling DefineFormEvents', WHITE ); + DefineFormEvents( + // events marked with '^' can be set immediately following control creation: + // in case of FormCompact = TRUE this gives smaller code since there are less + // calls of FormSetCurCtl. + // --------------------------------------------------------------------------- + [ 'OnClick:^TControl.SetOnClick', + 'OnMouseDblClk:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseDblClk), + 'OnMessage: TControl.SetOnMessage', + 'OnMouseDown:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseDown), + 'OnMouseMove:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseMove), + 'OnMouseUp:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseUp), + 'OnMouseWheel:^TControl.SetOnMouseEvent,' + IntToStr(idx_fOnMouseWheel), + 'OnMouseEnter:^TControl.SetOnMouseEnter', + 'OnMouseLeave:^TControl.SetOnMouseLeave', + + 'OnDestroy:^TObj.SetOnDestroy', + 'OnEnter:^TControl.Set_TOnEvent,' + IntToStr(idx_fOnEnter), + 'OnLeave:^TControl.Set_TOnEvent,' + IntToStr(idx_fOnLeave), + 'OnKeyDown:^TControl.SetOnKeyDown', + 'OnKeyUp:^TControl.SetOnKeyUp', + 'OnKeyChar:^TControl.SetOnChar', + 'OnKeyDeadChar:^TControl.SetOnDeadChar', + + 'OnChange: TControl.Set_TOnEvent,' + IntToStr(idx_fOnChange), + 'OnSelChange: TControl.Set_TOnEvent,' + IntToStr(idx_fOnSelChange), + 'OnPaint:^TControl.SetOnPaint', + 'OnEraseBkgnd:^TControl.SetOnEraseBkgnd', + 'OnResize: TControl.SetOnResize', + 'OnMove: TControl.SetOnMove', + 'OnMoving: TControl.SetOnMoving', + 'OnBitBtnDraw:^TControl.Set_OnBitBtnDraw', + 'OnDropDown:^TControl.Set_TOnEvent,' + IntToStr(idx_fOnDropDown), + 'OnCloseUp:^TControl.Set_TOnEvent,' + IntToStr(idx_FOnCloseUp), + 'OnProgress:^TControl.Set_TOnEvent,' + IntToStr(idx_FOnProgress), + + 'OnDeleteAllLVItems:^TControl.SetOnDeleteAllLVItems', + 'OnDeleteLVItem:^TControl.SetOnDeleteLVItem', + 'OnLVData:^TControl.SetOnLVData', + 'OnCompareLVItems:^TControl.Set_OnCompareLVItems', + 'OnColumnClick:^TControl.SetOnColumnClick', + 'OnLVStateChange:^TControl.SetOnLVStateChange', + 'OnEndEditLVItem:^TControl.SetOnEndEditLVItem', + + 'OnDrawItem:^TControl.SetOnDrawItem', + 'OnMeasureItem:^TControl.SetOnMeasureItem', + 'OnTBDropDown:^TControl.Set_TOnEvent,' + IntToStr(idx_FOnDropDown), + 'OnDropFiles:^TControl.SetOnDropFiles', + 'OnShow:^TControl.SetOnShow', + 'OnHide:^TControl.SetOnHide', + 'OnSplit:^TControl.Set_OnSplit', + 'OnScroll:^TControl.SetOnScroll', + + 'OnRE_OverURL:^TControl.RESetOnURL,0', + 'OnRE_URLClick:^TControl.RESetOnURL,8', + 'OnRE_InsOvrMode_Change:^TControl.Set_TOnEvent,' + IntToStr(idx_FOnREInsModeChg), + + 'OnTVBeginDrag:^TControl.Set_OnTVBeginDrag', + 'OnTVBeginEdit:^TControl.Set_OnTVBeginEdit', + 'OnTVEndEdit:^TControl.Set_OnTVEndEdit', + 'OnTVExpanded:^TControl.Set_OnTVExpanded', + 'OnTVExpanding:^TControl.Set_OnTVExpanding', + 'OnTVSelChanging:^TControl.Set_OnTVSelChanging', + 'OnTVDelete:^TControl.SetOnTVDelete' + ] ); + Rpt( 'Called DefineFormEvents ---', WHITE ); DoAssignEvents( SL, AName, [ 'OnClick', 'OnMouseDblClk', 'OnMessage', 'OnMouseDown', 'OnMouseMove', 'OnMouseUp', 'OnMouseWheel', 'OnMouseEnter', 'OnMouseLeave' ], [ @OnClick, @ OnMouseDblClk, @OnMessage, @OnMouseDown, @OnMouseMove, @OnMouseUp, @OnMouseWheel, @OnMouseEnter, @OnMouseLeave ] ); @@ -4979,7 +5130,8 @@ begin FDefHasBorder := TRUE; //Change; - FOverrideScrollbars := TRUE; + if F <> nil then + FOverrideScrollbars := F.OverrideScrollbars; LogOK; finally @@ -5045,6 +5197,12 @@ begin fNotifyList.Free; fNotifyList := nil; FBrush.Free; {YS}//! Memory leak fix + if FEventDefs <> nil then + for I := 0 to FEventDefs.Count-1 do + begin + FreeMem( Pointer( FEventDefs.Objects[I] ) ); + end; + FreeAndNil( FEventDefs ); inherited; if (F <> nil) and not F.FIsDestroying and (Owner <> nil) and not(csDestroying in Owner.ComponentState) then @@ -5057,8 +5215,14 @@ begin end; procedure TKOLCustomControl.DoAssignEvents(SL: TStringList; const AName: String; - const EventNames: array of PAnsiChar; const EventHandlers: array of Pointer); + const EventNames: array of PChar; const EventHandlers: array of Pointer); var I: Integer; + KF: TKOLForm; + add_SL: Boolean; + j: Integer; + s: KOLString; + ev_setter, ev_handler: String; + N_ev_setter, N_ev_handler: Integer; begin asm jmp @@e_signature @@ -5069,11 +5233,54 @@ begin //Log( '->TKOLCustomControl.DoAssignEvents' ); try + KF := ParentKOLForm; + for I := 0 to High( EventHandlers ) do begin if EventHandlers[ I ] <> nil then - SL.Add( ' ' + AName + '.' + AnsiString(EventNames[ I ]) + ' := Result.' + - ParentForm.MethodName( EventHandlers[ I ] ) + ';' ); + begin + add_SL := TRUE; + if (KF <> nil) and KF.FormCompact and + (FEventDefs <> nil) then + begin + j := FEventDefs.IndexOf( EventNames[I] ); + if j >= 0 then + begin + s := PChar( FEventDefs.Objects[j] ); + if s = '' then continue; + if FAssignOnlyWinEvents and (s[1] = '^') then + continue; + if FAssignOnlyUserEvents and (s[1] <> '^') then + continue; + if s[1] = '^' then + Delete( s, 1, 1 ); + ev_setter := Trim( Parse( s, ',' ) ); + ev_handler := 'T' + KF.formName + '.' + + ParentForm.MethodName( EventHandlers[ I ] ); + N_ev_setter := KF.FormAddAlphabet( ev_setter, FALSE, FALSE ); + N_ev_handler := KF.FormAddAlphabet( ev_handler, FALSE, FALSE ); + s := Trim( s ); + if s = '' then + begin + KF.FormAddCtlCommand( Name, 'FormSetEvent' ); + KF.FormAddNumParameter( N_ev_handler ); + KF.FormAddNumParameter( N_ev_setter ); + end + else + begin + KF.FormAddCtlCommand( Name, 'FormSetIndexedEvent' ); + KF.FormAddNumParameter( N_ev_handler ); + KF.FormAddNumParameter( StrToInt( s ) ); + KF.FormAddNumParameter( N_ev_setter ); + end; + add_SL := FALSE; + end; + end; + if add_SL then + SL.Add( ' ' + AName + '.' + String( EventNames[ I ] ) + + ' := Result.' + + ParentForm.MethodName( EventHandlers[ I ] ) + ';' ); + end; end; //LogOK; @@ -7631,6 +7838,7 @@ begin end; procedure TKOLCustomControl.SetupColor(SL: TStrings; const AName: String); +var KF: TKOLForm; begin asm jmp @@e_signature @@ -7638,19 +7846,28 @@ begin DB 'TKOLCustomControl.SetupColor', 0 @@e_signature: end; + + KF := ParentKOLForm; + if (Brush.Bitmap = nil) or Brush.Bitmap.Empty then begin - if Brush.BrushStyle <> bsSolid then - Brush.GenerateCode( SL, AName ) - else - begin - if DefaultKOLParentColor and not parentColor or - not DefaultKOLParentColor and (Color <> DefaultColor) then - SL.Add( ' ' + AName + '.Color := TColor(' + Color2Str( Color ) + ');' ); - end; + if Brush.BrushStyle <> bsSolid then + Brush.GenerateCode( SL, AName ) + else + begin + if DefaultKOLParentColor and not parentColor or + not DefaultKOLParentColor and (Color <> DefaultColor) then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetColor' ); + KF.FormAddNumParameter( (Color shl 1) or (Color shr 31) ); + //SL.Add( '//Color = ' + IntToStr( Color ) ); + end else + SL.Add( ' ' + AName + '.Color := TColor(' + Color2Str( Color ) + ');' ); + end; end - else - Brush.GenerateCode( SL, AName ); + else + Brush.GenerateCode( SL, AName ); end; procedure TKOLCustomControl.SetupConstruct(SL: TStringList; const AName, AParent, @@ -7665,9 +7882,22 @@ begin end; Log( '->TKOLCustomControl.SetupConstruct' ); try - S := GenerateTransparentInits; - SL.Add( Prefix + AName + ' := New' + TypeName + '( ' - + SetupParams( AName, AParent ) + ' )' + S + ';' ); + if ParentKOLForm.FormCompact + and SupportsFormCompact then + begin + if HasCompactConstructor then + SetupConstruct_Compact + else + SL.Add( Prefix + AName + ' := New' + TypeName + '( ' + + SetupParams( AName, AParent ) + ' );' ); + GenerateTransparentInits_Compact; + end + else + begin + S := GenerateTransparentInits; + SL.Add( Prefix + AName + ' := New' + TypeName + '( ' + + SetupParams( AName, AParent ) + ' )' + S + ';' ); + end; SetupName( SL, AName, AParent, Prefix ); SetupSetUnicode( SL, AName ); LogOK; @@ -7678,6 +7908,8 @@ end; procedure TKOLCustomControl.SetupFirst(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; + CompactCode: Boolean; begin asm jmp @@e_signature @@ -7690,81 +7922,232 @@ begin SetupConstruct( SL, AName, AParent, Prefix ); SetupName( SL, AName, AParent, Prefix ); - if Tag <> 0 then + + KF := ParentKOLForm; + CompactCode := (KF <> nil) and KF.FormCompact and SupportsFormCompact; + + if Tag <> 0 then begin - if Tag < 0 then - SL.Add( Prefix + AName + '.Tag := DWORD(' + IntToStr(Tag) + ');' ) - else - SL.Add( Prefix + AName + '.Tag := ' + IntToStr(Tag) + ';' ); + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetTag' ); + KF.FormAddNumParameter( Tag ); + end + else + begin + if Tag < 0 then + SL.Add( Prefix + AName + '.Tag := DWORD(' + IntToStr(Tag) + ');' ) + else + SL.Add( Prefix + AName + '.Tag := ' + IntToStr(Tag) + ';' ); + end; end; - if not Ctl3D then - SL.Add( Prefix + AName + '.Ctl3D := False;' ); - if FHasBorder <> FDefHasBorder then + + if not Ctl3D then + if CompactCode then + KF.FormAddCtlCommand( Name, 'FormResetCtl3D' ) + else + SL.Add( Prefix + AName + '.Ctl3D := False;' ); + + if FHasBorder <> FDefHasBorder then begin - SL.Add( Prefix + AName + '.HasBorder := ' + BoolVals[ FHasBorder ] + ';' ); + if CompactCode then + begin + if HasBorder then + KF.FormAddCtlCommand( Name, 'TControl.SetHasBorder' ) + // param = 1 + else + KF.FormAddCtlCommand( Name, 'FormSetHasBorderFalse' ); + end else + SL.Add( Prefix + AName + '.HasBorder := ' + BoolVals[ FHasBorder ] + ';' ); //ShowMessage( AName + '.HasBorder := ' + BoolVals[ FHasBorder ] ); end; + SetupTabOrder( SL, AName ); SetupFont( SL, AName ); SetupTextAlign( SL, AName ); - if (csAcceptsControls in ControlStyle) or BorderNeeded then - if (ParentKOLControl = ParentKOLForm) and (ParentKOLForm.Border <> Border) - or (ParentKOLControl <> ParentKOLForm) and ((ParentKOLControl as TKOLCustomControl).Border <> Border) then - SL.Add( Prefix + AName + '.Border := ' + IntToStr( Border ) + ';' ); - if MarginTop <> DefaultMarginTop then - SL.Add( Prefix + AName + '.MarginTop := ' + IntToStr( MarginTop ) + ';' ); - if MarginBottom <> DefaultMarginBottom then - SL.Add( Prefix + AName + '.MarginBottom := ' + IntToStr( MarginBottom ) + ';' ); - if MarginLeft <> DefaultMarginLeft then - SL.Add( Prefix + AName + '.MarginLeft := ' + IntToStr( MarginLeft ) + ';' ); - if MarginRight <> DefaultMarginRight then - SL.Add( Prefix + AName + '.MarginRight := ' + IntToStr( MarginRight ) + ';' ); - if not IsCursorDefault then - if Copy( Cursor_, 1, 4 ) = 'IDC_' then - SL.Add( Prefix + AName + '.Cursor := LoadCursor( 0, ' + Cursor_ + ' );' ) - else + if (csAcceptsControls in ControlStyle) or BorderNeeded then + if (ParentKOLControl = ParentKOLForm) and (ParentKOLForm.Border <> Border) + or (ParentKOLControl <> ParentKOLForm) and ((ParentKOLControl as TKOLCustomControl).Border <> Border) then + if CompactCode then + begin + if Border = 1 then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetBorder' ); + // param = 1 + end + else + begin + KF.FormAddCtlCommand( Name, 'FormSetBorder' ); + KF.FormAddNumParameter( Border ); + end; + end else + SL.Add( Prefix + AName + '.Border := ' + IntToStr( Border ) + ';' ); + + if MarginTop <> DefaultMarginTop then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetMarginTop' ); + KF.FormAddNumParameter( MarginTop ); + end else + SL.Add( Prefix + AName + '.MarginTop := ' + IntToStr( MarginTop ) + ';' ); + + if MarginBottom <> DefaultMarginBottom then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetMarginBottom' ); + KF.FormAddNumParameter( MarginBottom ); + end else + SL.Add( Prefix + AName + '.MarginBottom := ' + IntToStr( MarginBottom ) + ';' ); + + if MarginLeft <> DefaultMarginLeft then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetMarginLeft' ); + KF.FormAddNumParameter( MarginLeft ); + end else + SL.Add( Prefix + AName + '.MarginLeft := ' + IntToStr( MarginLeft ) + ';' ); + + if MarginRight <> DefaultMarginRight then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetMarginRight' ); + KF.FormAddNumParameter( MarginRight ); + end else + SL.Add( Prefix + AName + '.MarginRight := ' + IntToStr( MarginRight ) + ';' ); + + if not IsCursorDefault then + if Copy( Cursor_, 1, 4 ) = 'IDC_' then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormCursorLoad_0' ); + KF.FormAddNumParameter( IDC2Number( Cursor_ ) ); + end else + SL.Add( Prefix + AName + '.Cursor := LoadCursor( 0, ' + Cursor_ + ' );' ) + else + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormCursorLoad_hInstance' ); + KF.FormAddStrParameter( Cursor_ ); + end else SL.Add( Prefix + AName + '.Cursor := LoadCursor( hInstance, ''' + Trim( Cursor_ ) + ''' );' ); - if not Visible and (Faction = nil) then - SL.Add( Prefix + AName + '.Visible := False;' ); - if not Enabled and (Faction = nil) then - SL.Add( Prefix + AName + '.Enabled := False;' ); - if DoubleBuffered and not Transparent then - SL.Add( Prefix + AName + '.DoubleBuffered := True;' ); - if Owner <> nil then - if Transparent and ((Owner is TKOLCustomControl) and not (Owner as TKOLCustomControl).Transparent or - not(Owner is TKOLCustomControl) and not ParentKOLForm.Transparent) then - SL.Add( Prefix + AName + '.Transparent := True;' ); - if Owner = nil then - if Transparent then - SL.Add( Prefix + AName + '.Transparent := TRUE;' ); - //AssignEvents( SL, AName ); - if EraseBackground then - SL.Add( Prefix + AName + '.EraseBackground := TRUE;' ); - if MinWidth > 0 then - SL.Add( Prefix + AName + '.MinWidth := ' + IntToStr( MinWidth ) + ';' ); - if MinHeight > 0 then - SL.Add( Prefix + AName + '.MinHeight := ' + IntToStr( MinHeight ) + ';' ); - if MaxWidth > 0 then - SL.Add( Prefix + AName + '.MaxWidth := ' + IntToStr( MaxWidth ) + ';' ); - if MaxHeight > 0 then - SL.Add( Prefix + AName + '.MaxHeight := ' + IntToStr( MaxHeight ) + ';' ); - if IgnoreDefault <> FDefIgnoreDefault then - SL.Add( Prefix + AName + '.IgnoreDefault := ' + BoolVals[ IgnoreDefault ] + ';' ); + + if not Visible and (Faction = nil) then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetVisibleFalse' ); + end else + SL.Add( Prefix + AName + '.Visible := False;' ); + + if not Enabled and (Faction = nil) then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetEnabledFalse' ); + end else + SL.Add( Prefix + AName + '.Enabled := False;' ); + + if DoubleBuffered and not Transparent then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetDoubleBuffered' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.DoubleBuffered := True;' ); + + if Owner <> nil then + if Transparent and ((Owner is TKOLCustomControl) + and not (Owner as TKOLCustomControl).Transparent + or not(Owner is TKOLCustomControl) + and not ParentKOLForm.Transparent) then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetTransparent' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.Transparent := True;' ); + + if Owner = nil then + if Transparent then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetTransparent' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.Transparent := TRUE;' ); + + if EraseBackground then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetEraseBkgndTrue' ); + end else + SL.Add( Prefix + AName + '.EraseBackground := TRUE;' ); + + if MinWidth > 0 then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetMinWidth' ); + KF.FormAddNumParameter( MinWidth ); + end else + SL.Add( Prefix + AName + '.MinWidth := ' + IntToStr( MinWidth ) + ';' ); + + if MinHeight > 0 then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetMinHeight' ); + KF.FormAddNumParameter( MinHeight ); + end else + SL.Add( Prefix + AName + '.MinHeight := ' + IntToStr( MinHeight ) + ';' ); + + if MaxWidth > 0 then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetMaxWidth' ); + KF.FormAddNumParameter( MaxWidth ); + end else + SL.Add( Prefix + AName + '.MaxWidth := ' + IntToStr( MaxWidth ) + ';' ); + + if MaxHeight > 0 then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetMaxHeight' ); + KF.FormAddNumParameter( MaxHeight ); + end else + SL.Add( Prefix + AName + '.MaxHeight := ' + IntToStr( MaxHeight ) + ';' ); + + if IgnoreDefault <> FDefIgnoreDefault then + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetIgnoreDefault' ); + KF.FormAddNumParameter( Integer( not IgnoreDefault ) ); + end else + SL.Add( Prefix + AName + '.IgnoreDefault := ' + BoolVals[ IgnoreDefault ] + ';' ); + //Rpt( '-------- FHint = ' + FHint ); - if (Trim( FHint ) <> '') and (Faction = nil) then + if (Trim( FHint ) <> '') and (Faction = nil) then begin - if (ParentKOLForm <> nil) and ParentKOLForm.ShowHint then - begin - SL.Add( Prefix + '{$IFDEF USE_MHTOOLTIP}' ); - SL.Add( Prefix + AName + '.Hint.Text := ' + StringConstant( 'Hint', Hint ) + ';' ); - SL.Add( Prefix + '{$ENDIF USE_MHTOOLTIP}' ); - end; + if (ParentKOLForm <> nil) and ParentKOLForm.ShowHint then + begin + if CompactCode then + begin + KF.FormAddCtlCommand( Name, 'FormSetHintText' ); + KF.FormAddStrParameter( Hint ); + end + else + begin + SL.Add( Prefix + '{$IFDEF USE_MHTOOLTIP}' ); + SL.Add( Prefix + AName + '.Hint.Text := ' + StringConstant( 'Hint', Hint ) + ';' ); + SL.Add( Prefix + '{$ENDIF USE_MHTOOLTIP}' ); + end; + end; end; - if SetupColorFirst then - SetupColor( SL, AName ); - if Assigned( FpopupMenu ) then - SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name + - ' );' ); + + if SetupColorFirst then + SetupColor( SL, AName ); + + {-- move to SetupLast: + if Assigned( FpopupMenu ) then + SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name + + ' );' ); + } LogOK; finally @@ -7794,6 +8177,8 @@ end; procedure TKOLCustomControl.SetupLast(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; + i: Integer; begin asm jmp @@e_signature @@ -7803,27 +8188,80 @@ begin end; //Log( '->TKOLCustomControl.SetupLast' ); try - if not SetupColorFirst then - SetupColor( SL, AName ); + + KF := ParentKOLForm; + Rpt( 'Setuplast for form entered', WHITE ); + + if not SetupColorFirst then + SetupColor( SL, AName ); + + if Assigned( FpopupMenu ) then + SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name + + ' );' ); + + Rpt( 'AssignEvents for control calling', WHITE ); + RptDetailed( Name, YELLOW ); + FAssignOnlyUserEvents := FALSE; + if (KF <> nil) and KF.FormCompact then + FAssignOnlyWinEvents := TRUE; AssignEvents( SL, AName ); - if fDefaultBtn then - SL.Add( Prefix + AName + '.DefaultBtn := TRUE;' ); - if fCancelBtn then - SL.Add( Prefix + AName + '.CancelBtn := TRUE;' ); + FAssignOnlyWinEvents := FALSE; + Rpt( 'AssignEvents for control called', WHITE ); + RptDetailed( Name, YELLOW ); - if AnchorRight or AnchorBottom then - SL.Add( Prefix + AName + '.Anchor(' + - BoolVals[ AnchorLeft ] + ', ' + - BoolVals[ AnchorTop ] + ', ' + - BoolVals[ AnchorRight ] + ', ' + - BoolVals[ AnchorBottom ] + ');' ); + if fDefaultBtn then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetDefaultBtn' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.DefaultBtn := TRUE;' ); - if FOverrideScrollbars and FHasScrollbarsToOverride then + if fCancelBtn then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetCancelBtn' ); + // param = 1 + end else + SL.Add( Prefix + AName + '.CancelBtn := TRUE;' ); + + if AnchorRight or AnchorBottom then + if (KF <> nil) and KF.FormCompact then + begin + i := Integer( AnchorLeft ) + + Integer( AnchorTop ) shl 1 + + Integer( AnchorRight ) shl 2 + + Integer( AnchorBottom ) shl 3; + CASE i OF + 1: KF.FormAddCtlCommand( Name, 'TControl.SetAnchorLeft' ); + 2: KF.FormAddCtlCommand( Name, 'TControl.SetAnchorTop' ); + 4: KF.FormAddCtlCommand( Name, 'TControl.SetAnchorRight' ); + 8: KF.FormAddCtlCommand( Name, 'TControl.SetAnchorBottom' ); + else + KF.FormAddCtlCommand( Name, 'FormSetAnchor' ); + KF.FormAddNumParameter( i ); + END; + end else + SL.Add( Prefix + AName + '.Anchor(' + + BoolVals[ AnchorLeft ] + ', ' + + BoolVals[ AnchorTop ] + ', ' + + BoolVals[ AnchorRight ] + ', ' + + BoolVals[ AnchorBottom ] + ');' ); + + if FOverrideScrollbars and FHasScrollbarsToOverride then begin - SL.Add( Prefix + '{$IFDEF OVERRIDE_SCROLLBARS}' ); - SL.Add( Prefix + 'OverrideScrollbars( ' + AName + ');' ); - SL.Add( Prefix + '{$ENDIF OVERRIDE_SCROLLBARS}' ); + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormOverrideScrollbars' ); + end + else + begin + SL.Add( Prefix + '{$IFDEF OVERRIDE_SCROLLBARS}' ); + SL.Add( Prefix + 'OverrideScrollbars( ' + AName + ');' ); + SL.Add( Prefix + '{$ENDIF OVERRIDE_SCROLLBARS}' ); + end; end; + Rpt( 'Setuplast for form finished', WHITE ); //LogOK; finally @@ -7881,6 +8319,7 @@ procedure TKOLCustomControl.SetupTabOrder(SL: TStringList; const AName: String); порядок генерации конструкторов для визуальных объектов, при котором TabOrder получается такой, какой нужно. } +var KF: TKOLForm; begin asm jmp @@e_signature @@ -7889,13 +8328,25 @@ begin @@e_signature: end; Log( '->TKOLCustomControl.SetupTabOrder' ); + + KF := ParentKOLForm; + try if not TabStop and TabStopByDefault then begin - if FResetTabStopByStyle then - SL.Add( ' ' + AName + '.Style := ' + AName + '.Style and not WS_TABSTOP;' ) + if FResetTabStopByStyle then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormResetStyles' ); + KF.FormAddNumParameter( WS_TABSTOP ); + end else + SL.Add( ' ' + AName + '.Style := ' + AName + '.Style and not WS_TABSTOP;' ) else - SL.Add( ' ' + AName + '.TabStop := FALSE;' ); + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Name, 'FormSetTabStopFalse' ); + end else + SL.Add( ' ' + AName + '.TabStop := FALSE;' ); end; LogOK; finally @@ -8841,13 +9292,6 @@ begin end; {$ENDIF NOT_USE_KOLCTRLWRAPPER} -procedure TKOLCustomControl.SetUnicode(const Value: Boolean); -begin - if FUnicode = Value then Exit; - FUnicode := Value; - Change; -end; - procedure TKOLCustomControl.Setaction(const Value: TKOLAction); begin Log( '->TKOLCustomControl.Setaction' ); @@ -9047,11 +9491,11 @@ begin end; function TKOLCustomControl.P_DoAssignEvents(SL: TStringList; - const AName: String; const EventNames: array of PAnsiChar; + const AName: String; const EventNames: array of PChar; const EventHandlers: array of Pointer; const EventAssignProc: array of Boolean; CheckOnly: Boolean): Boolean; var I: Integer; - s, p: AnsiString; + s, p: KOLString; begin asm jmp @@e_signature @@ -9426,7 +9870,7 @@ begin if (HelpContext <> 0) and (Faction = nil) then //S := S + '.AssignHelpContext( ' + IntToStr( HelpContext ) + ' )' ; {P}S := S + ' L(' + IntToStr( HelpContext ) + ') C1 TControl.AssignHelpContext<2>'; - if Unicode then + if (KF <> nil) and KF.Unicode then //S := S + '.SetUnicode( TRUE )'; {P}S := S + #13#10' IFNDEF(UNICODE_CTRLS)'#13#10' L(1) C1 TControl.SetUnicode<2>'+ #13#10' ENDIF'; @@ -9538,7 +9982,7 @@ procedure TKOLCustomControl.P_ProvideFakeType(SL: TStrings; var i: Integer; begin for i := 0 to SL.Count-1 do - if StrEq( SL[ i ], Declaration ) then Exit; + if AnsiCompareText( SL[ i ], Declaration ) = 0 then Exit; SL.Insert( 1, Declaration ); end; @@ -9628,20 +10072,31 @@ end; procedure TKOLCustomControl.SetupName(SL: TStringList; const AName, AParent, Prefix: String); +var KF: TKOLForm; begin if FNameSetuped then Exit; - if Name <> '' then + KF := ParentKOLForm; + if KF = nil then Exit; + if (Name <> '') and KF.GenerateCtlNames then begin - SL.Add( ' {$IFDEF USE_NAMES}' ); - // maybe user placed visual control on DataModule? - - if AParent <> 'nil' then // this control placed NOT on datamodule - Sl.Add(Format( '%s%s.SetName( Result.Form, ''%s'' ); ', [Prefix, AName, Name])) - else // not on form - Sl.Add(Format( '%s%s.SetName( Result, ''%s'' ); ', [Prefix, AName, Name])); - - SL.Add( ' {$ENDIF}' ); - FNameSetuped := TRUE; + if KF.FormCompact and SupportsFormCompact then + begin + if AParent <> 'nil' then + begin + KF.FormAddCtlCommand( Name, 'FormSetName' ); + KF.FormAddStrParameter( Name ); + end + else + SL.Add(Format( '%s%s.SetName( Result, ''%s'' ); ', [Prefix, AName, Name])); + end + else + begin + if AParent <> 'nil' then // this control placed NOT on datamodule + SL.Add(Format( '%s%s.SetName( Result.Form, ''%s'' ); ', [Prefix, AName, Name])) + else // not on form + SL.Add(Format( '%s%s.SetName( Result, ''%s'' ); ', [Prefix, AName, Name])); + end; + FNameSetuped := TRUE; end; end; @@ -9703,10 +10158,17 @@ begin end; procedure TKOLCustomControl.SetupSetUnicode(SL: TStringList; const AName: String); +var KF: TKOLForm; begin - SL.Add( ' {$IFDEF UNICODE_CTRLS}' ); - SL.Add( ' ' + AName + '.SetUnicode(TRUE);' ); - SL.Add( ' {$ENDIF UNICODE_CTRLS}' ); + KF := ParentKOLForm; + if KF = nil then Exit; + if KF.Unicode then + begin + if KF.FormCompact and SupportsFormCompact then + KF.FormAddCtlCommand( Name, 'FormSetUnicode' ) + else + SL.Add( ' ' + AName + '.SetUnicode(TRUE);' ); + end; end; procedure TKOLCustomControl.SetAcceptChildren(const Value: Boolean); @@ -9744,6 +10206,213 @@ begin Change; end; +function TKOLCustomControl.SupportsFormCompact: Boolean; +begin + Result := FALSE; +end; + +procedure TKOLCustomControl.GenerateTransparentInits_Compact; +var KF: TKOLForm; +begin + asm + jmp @@e_signature + DB '#$signature$#', 0 + DB 'TKOLCustomControl.GenerateTransparentInits_Compact', 0 + @@e_signature: + end; + Log( '->TKOLCustomControl.GenerateTransparentInits_Compact' ); + try + + KF := ParentKOLForm; + if KF = nil then Exit; + + if Align = caNone then + begin + if IsGenerateSize then + begin + if PlaceRight then + KF.FormAddCtlCommand( Name, 'TControl.PlaceRight' ) + else + if PlaceDown then + KF.FormAddCtlCommand( Name, 'TControl.PlaceDown' ) + else + if PlaceUnder then + KF.FormAddCtlCommand( Name, 'TControl.PlaceUnder' ) + else + if not CenterOnParent then + if (actualLeft <> ParentMargin) or (actualTop <> ParentMargin) then + begin + KF.FormAddCtlCommand( Name, 'FormSetPosition' ); + KF.FormAddNumParameter( actualLeft ); + KF.FormAddNumParameter( actualTop ); + end; + end; + end; + if Align <> caNone then + begin + if Integer( Align ) = 1 then + begin + KF.FormAddCtlCommand( Name, 'TControl.Set_Align' ); + // param = 1 + end + else + begin + KF.FormAddCtlCommand( Name, 'FormSetAlign' ); + KF.FormAddNumParameter( Integer( Align ) ); + end; + end; + Generate_SetSize_Compact; + if CenterOnParent and (Align = caNone) then + KF.FormAddCtlCommand( Name, 'TControl.CenterOnParent' ); + if KF.zOrderChildren then + KF.FormAddCtlCommand( Name, 'TControl.BringToFront' ); + if EditTabChar then + KF.FormAddCtlCommand( Name, 'TControl.EditTabChar' ); + if (HelpContext <> 0) and (Faction = nil) then + begin + KF.FormAddCtlCommand( Name, 'FormAssignHelpContext' ); + KF.FormAddNumParameter( HelpContext ); + end; + if MouseTransparent then + KF.FormAddCtlCommand( Name, 'TControl.MouseTransparent' ); + if LikeSpeedButton then + KF.FormAddCtlCommand( Name, 'TControl.LikeSpeedButton' ); + + LogOK; + finally + Log( '<-TKOLCustomControl.GenerateTransparentInits_Compact' ); + end; +end; + +procedure TKOLCustomControl.SetupConstruct_Compact; +begin + // must be overriden when SupportsFormCompact returns TRUE + ParentKOLForm.FormAddCtlParameter( Name ); + ParentKOLForm.FormCurrentCtlForTransparentCalls := Name; +end; + +procedure TKOLCustomControl.Generate_SetSize_Compact; +const BoolVals: array[ Boolean ] of String = ( 'FALSE', 'TRUE' ); +var W, H: Integer; + SizeWasSet: Boolean; + KF: TKOLForm; +begin + Log( '->TKOLCustomControl.Generate_SetSize_Compact' ); + try + + KF := ParentKOLForm; + if KF = nil then Exit; + + SizeWasSet := FALSE; + W := 0; + H := 0; + if Align <> caClient then + if (Width <> DefaultWidth) or (Height <> DefaultHeight) or not Windowed then + begin + if ((Width <> DefaultWidth) or not Windowed) + and not (Align in [ caTop, caBottom ]) then + W := Width; + if ((Height <> DefaultHeight) or not Windowed) + and not (Align in [ caLeft, caRight ]) then + H := Height; + end; + + if IsGenerateSize or not Windowed then + if not (autoSize and AutoSizeRunTime) or WordWrap or fNoAutoSizeX then + begin + if autoSize and AutoSizeRunTime then + H := 0; + if (W <> 0) or (H <> 0) then + begin + KF.FormAddCtlCommand( Name, 'FormSetSize' ); + KF.FormAddNumParameter( W ); + KF.FormAddNumParameter( H ); + SizeWasSet := TRUE; + end; + end; + if WordWrap then + KF.FormAddCtlCommand( Name, 'TControl.MakeWordWrap' ); // param = 1 + if (AutoSize and AutoSizeRunTime) xor DefaultAutoSize then + KF.FormAddCtlCommand( Name, 'TControl.AutoSize' ); // param = 1 + + if not SizeWasSet then + //Result := Result + '{Generate_SetSize W' + IntToStr(W) + 'H' + IntToStr(H) + '} ' + ; + + LogOK; + finally + Log( '<-TKOLCustomControl.Generate_SetSize_Compact' ); + end; +end; + +procedure TKOLCustomControl.GenerateVerticalAlign( SL: TStrings; const AName: String ); +var KF: TKOLForm; +begin + KF := ParentKOLForm; + if (KF <> nil) and KF.FormCompact then + begin + if Integer( VerticalAlign ) = 1 then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetVerticalAlign' ); + // param = 1 + end + else + begin + KF.FormAddCtlCommand( Name, 'FormSetVTextVAlign' ); + KF.FormAddNumParameter( Integer( VerticalAlign ) ); + end; + end else + SL.Add( ' ' + AName + '.VerticalAlign := KOL.' + VertAligns[ VerticalAlign ] + ';' ); +end; + +procedure TKOLCustomControl.GenerateTextAlign(SL: TStrings; + const AName: String); +var KF: TKOLForm; +begin + KF := ParentKOLForm; + if (KF <> nil) and KF.FormCompact then + begin + if Integer( TextAlign ) = 1 then + begin + KF.FormAddCtlCommand( Name, 'TControl.SetTextAlign' ); + // param = 1 + end + else + begin + KF.FormAddCtlCommand( Name, 'FormSetTextAlign' ); + KF.FormAddNumParameter( Integer( TextAlign ) ); + end; + end else + SL.Add( ' ' + AName + '.TextAlign := KOL.' + TextAligns[ TextAlign ] + ';' ); +end; + +function TKOLCustomControl.HasCompactConstructor: Boolean; +begin + Result := SupportsFormCompact; +end; + +procedure TKOLCustomControl.DefineFormEvents( + const EventNamesAndDefs: array of String); +var i: Integer; + s: KOLString; + ev_name: String; + StoreDef: PChar; +begin + if FEventDefs = nil then + FEventDefs := TStringList.Create; + for i := 0 to High(EventNamesAndDefs) do + begin + s := EventNamesAndDefs[i]; + ev_name := {$IFDEF UNICODE_CTRLS} ParseW {$ELSE} Parse {$ENDIF} ( s, ':' ); + if FEventDefs.IndexOf( ev_name ) >= 0 then + continue; + s := Trim(s); + GetMem( StoreDef, Length( s )+1 ); + Move( s[1], StoreDef^, Length(s)+1 ); + FEventDefs.AddObject( ev_name, Pointer( StoreDef ) ); + end; +end; + { TKOLApplet } procedure TKOLApplet.AssignEvents(SL: TStringList; const AName: String); @@ -9990,6 +10659,28 @@ begin END; end; +procedure TKOLApplet.DefineFormEvents( + const EventNamesAndDefs: array of String); +var i: Integer; + s: KOLString; + ev_name: String; + StoreDef: PAnsiChar; +begin + if FEventDefs = nil then + FEventDefs := TStringList.Create; + for i := 0 to High(EventNamesAndDefs) do + begin + s := EventNamesAndDefs[i]; + ev_name := Parse( s, ':' ); + if FEventDefs.IndexOf( ev_name ) >= 0 then + continue; + s := Trim(s); + GetMem( StoreDef, Length( s )+1 ); + Move( s[1], StoreDef^, Length(s)+1 ); + FEventDefs.AddObject( ev_name, Pointer( StoreDef ) ); + end; +end; + destructor TKOLApplet.Destroy; begin asm @@ -10012,8 +10703,13 @@ begin end; procedure TKOLApplet.DoAssignEvents(SL: TStringList; const AName: String; - EventNames: array of PAnsiChar; EventHandlers: array of Pointer); -var I: Integer; + EventNames: array of PChar; EventHandlers: array of Pointer); +var I, j: Integer; + add_SL: Boolean; + s: KOLString; + ev_setter, ev_handler: String; + N_ev_setter, N_ev_handler: Integer; + FF: TKOLForm; begin asm jmp @@e_signature @@ -10024,13 +10720,59 @@ begin //Log( '->TKOLApplet.DoAssignEvents' ); TRY + RptDetailed( 'DoAssignEvents begin', WHITE ); + for I := 0 to High( EventHandlers ) do begin if EventHandlers[ I ] <> nil then - SL.Add( ' ' + AName + '.' + AnsiString(EventNames[ I ]) + ' := Result.' + - (Owner as TForm).MethodName( EventHandlers[ I ] ) + ';' ); // TODO: KOL_ANSI + begin + add_SL := TRUE; + if (Self is TKOLForm) and (Owner <> nil) and (Owner is TCustomForm) + and (Self as TKOLForm).FormCompact and (FEventDefs <> nil) then + begin + FF := Self as TKOLForm; + j := FEventDefs.IndexOf( EventNames[I] ); + if j >= 0 then + begin + s := PChar( FEventDefs.Objects[j] ); + if s = '' then continue; + if FAssignOnlyWinEvents and (s[1] = '^') then + continue; + if FAssignOnlyUserEvents and (s[1] <> '^') then + continue; + if s[1] = '^' then + Delete( s, 1, 1 ); + ev_setter := Trim( Parse( s, ',' ) ); + ev_handler := 'T' + FF.formName + '.' + + (Owner as TCustomForm).MethodName( EventHandlers[ I ] ); + N_ev_setter := FF.FormAddAlphabet( ev_setter, FALSE, FALSE ); + N_ev_handler := FF.FormAddAlphabet( ev_handler, FALSE, FALSE ); + s := Trim( s ); + if s = '' then + begin + FF.FormAddCtlCommand( Name, 'FormSetEvent' ); + FF.FormAddNumParameter( N_ev_handler ); + FF.FormAddNumParameter( N_ev_setter ); + end + else + begin + FF.FormAddCtlCommand( Name, 'FormSetIndexedEvent' ); + FF.FormAddNumParameter( N_ev_handler ); + FF.FormAddNumParameter( StrToInt( s ) ); + FF.FormAddNumParameter( N_ev_setter ); + end; + add_SL := FALSE; + end; + end; + if add_SL then + SL.Add( ' ' + AName + '.' + String(EventNames[ I ]) + + ' := Result.' + + (Owner as TForm).MethodName( EventHandlers[ I ] ) + ';' ); + // TODO: KOL_ANSI ??? + end; end; + RptDetailed( 'DoAssignEvents end', WHITE ); //LogOK; FINALLY //Log( '<-TKOLApplet.DoAssignEvents' ); @@ -10420,9 +11162,50 @@ begin try if not FLocked then begin - if (Applet <> nil) and (Applet.Owner = Owner) then - Applet.AssignEvents( SL, 'Applet' ); + RptDetailed( 'Enter to TKOLForm.AssignEvents', WHITE ); + + if (Applet <> nil) and (Applet.Owner = Owner) then + Applet.AssignEvents( SL, 'Applet' ); //inherited; + + DefineFormEvents( + // events marked with '^' can be set immediately following control creation: + // in case of FormCompact = TRUE this gives smaller code since there are less + // calls of FormSetCurCtl. + // --------------------------------------------------------------------------- + [ 'OnMessage: TControl.Set_OnMessage', + 'OnClose:^TControl.SetOnClose,' + IntToStr(idx_fOnMouseDown), + 'OnQueryEndSession:^TControl.SetOnQueryEndSession,' + IntToStr(idx_fOnMouseMove), + + 'OnMinimize:^TControl.SetOnMinMaxRestore,0', + 'OnMaximize:^TControl.SetOnMinMaxRestore,8', + 'OnRestore:^TControl.SetOnMinMaxRestore,16', + + 'OnFormClick:^TControl.SetFormOnClick', + 'OnMouseDblClk:^TControl.SetOnMouseEvent,' + IntToStr( idx_fOnMouseDblClk ), + 'OnMouseDown:^TControl.SetOnMouseEvent,' + IntToStr( idx_fOnMouseDown ), + 'OnMouseMove:^TControl.SetOnMouseEvent,' + IntToStr( idx_fOnMouseMove ), + 'OnMouseUp:^TControl.SetOnMouseEvent,' + IntToStr( idx_fOnMouseUp ), + 'OnMouseWheel:^TControl.SetOnMouseEvent,' + IntToStr( idx_fOnMouseWheel ), + 'OnMouseEnter:^TControl.SetOnMouseEnter', + 'OnMouseLeave:^TControl.SetOnMouseLeave', + + 'OnEnter:^TControl.Set_TOnEvent,' + IntToStr( idx_fOnEnter ), + 'OnLeave:^TControl.Set_TOnEvent,' + IntToStr( idx_fOnLeave ), + 'OnKeyDown:^TControl.SetOnKeyDown', + 'OnKeyUp:^TControl.SetOnKeyUp', + 'OnKeyChar:^TControl.SetOnKeyChar', + 'OnResize:^TControl.SetOnResize', + 'OnMove:^TControl.SetOnMove', + 'OnMoving:^TControl.SetOnMoving', + 'OnShow:^TControl.SetOnShow', + 'OnHide:^TControl.SetOnHide', + + 'OnPaint:^TControl.SetOnPaint', + 'OnEraseBkgnd:^TControl.SetOnEraseBkgnd', + 'OnDropFiles:^TControl.SetOnDropFiles' + ] ); + DoAssignEvents( SL, AName, [ 'OnMessage', 'OnClose', 'OnQueryEndSession' ], [ @OnMessage, @ OnClose, @ OnQueryEndSession ] ); DoAssignEvents( SL, AName, [ 'OnMinimize', 'OnMaximize', 'OnRestore' ], @@ -10447,6 +11230,7 @@ begin {if Assigned( OnDestroy ) then SL.Add( ' ' + AName + '.OnDestroy := Result.' + (Owner as TForm).MethodName( OnFormDestroy ) + ';' );} + RptDetailed( 'Leave TKOLForm.AssignEvents', WHITE ); end; LogOK; finally @@ -10734,6 +11518,8 @@ begin FParentLikeColorControls.Free; FStatusText.Free; ResStrings.Free; + FreeAndNil( FFormAlphabet ); + FreeAndNil( FFormCtlParams ); inherited; LogOK; finally @@ -11020,10 +11806,10 @@ begin tkWChar: begin Wc := WChar( GetOrdProp( C, {$IFDEF _D2orD3orD4} PI {$ELSE} PropName {$ENDIF} ) ); - if Wc in [ WChar(' ')..WChar(#127) ] then - PropValue := '''' + AnsiChar( Wc ) + '''' + if (Wc >= WChar(' ')) and (Wc <= WChar(#127)) then + PropValue := '''' + AnsiChar( Wc ) + '''' else - PropValue := 'WChar( ' + IntToStr( Ord( Wc ) ) + ' )'; + PropValue := 'WChar( ' + IntToStr( Ord( Wc ) ) + ' )'; end; tkMethod: begin @@ -11097,12 +11883,12 @@ begin for I := 0 to NProps-1 do begin PI := Props[ I ]; - PropName := PI.Name; + PropName := String( PI.Name ); DPI := nil; for J := 0 to NPropsD-1 do begin DPI := PropsD[ J ]; - if PropName = DPI.Name then break; + if PropName = String( DPI.Name ) then break; DPI := nil; end; @@ -11151,7 +11937,7 @@ end; procedure TKOLForm.GenerateChildren( SL: TStringList; OfParent: TComponent; const OfParentName: String; const Prefix: String; var Updated: Boolean ); -var I: Integer; +var I, J: Integer; L: TList; S: String; KC: TKOLCustomControl; @@ -11185,15 +11971,111 @@ begin for I := 0 to L.Count - 1 do begin KC := L.Items[ I ]; - SL.Add( ' // ' + KC.RefName + '.TabOrder = ' + IntToStr( KC.TabOrder ) ); + Rpt( 'generating code for ' + KC.Name, WHITE ); + //SL.Add( ' // ' + KC.RefName + '.TabOrder = ' + IntToStr( KC.TabOrder ) ); + // обеспечить правильный родительский контрол, если он изменился + if FormCompact then + begin + if KC.Parent is TCustomForm then + begin + Rpt( 'searching parent form to set as FormCurrentParent', WHITE ); + while FormCurrentParentCtl <> nil do + begin + FormAddCtlCommand( '', 'FormSetUpperParent' ); + if (FormCurrentParentCtl.Parent is TCustomForm) then + begin + FormCurrentParentCtl := nil; + FormCurrentParent := ''; + end + else + begin + FormCurrentParentCtl := (FormCurrentParentCtl.Parent as TKOLControl); + FormCurrentParent := FormCurrentParentCtl.Name; + end; + end; + end + else + if (KC.Parent is TKOLTabPage) and (KC.Parent.Parent is TKOLTabControl) then + begin + if FormCurrentParent <> KC.Parent.Name then + begin + RptDetailed( 'searching parent tab page to set as FormCurrentParent', WHITE ); + RptDetailed( 'Current parent name: ' + FormCurrentParent + + ', wanted: ' + KC.Parent.Name, WHITE ); + if FormCurrentCtlForTransparentCalls <> KC.Parent.Parent.Name then + begin + RptDetailed( 'setting up ' + KC.Parent.Parent.Name + + ' as current control', WHITE ); + FormAddCtlCommand( '', 'FormSetCurCtl' ); + FormAddNumParameter( FormIndexOfControl( KC.Parent.Parent.Name ) ); + FormCurrentCtlForTransparentCalls := KC.Parent.Parent.Name; + RptDetailed( 'successfully set up ' + KC.Parent.Parent.Name + + ' as current control', WHITE ); + end; + FormAddCtlCommand( '', 'FormSetTabpageAsParent' ); + J := (KC.Parent.Parent as TKOLTabControl).IndexOfPage( + KC.Parent.Name ); + FormAddNumParameter( J ); + FormCurrentParent := KC.Parent.Name; + FormCurrentParentCtl := KC.Parent as TKOLCustomControl; + end; + end + else + if KC.Parent <> FormCurrentParentCtl then + begin + Rpt( 'searching parent control to set as FormCurrentParent', WHITE ); + Rpt( KC.Parent.Name, WHITE ); + while (KC.Parent <> FormCurrentParentCtl) and + (FormCurrentParentCtl <> nil) do + begin + FormAddCtlCommand( '', 'FormSetUpperParent' ); + if (FormCurrentParentCtl.Parent is TCustomForm) then + begin + FormCurrentParentCtl := nil; + FormCurrentParent := ''; + end + else + begin + FormCurrentParentCtl := (FormCurrentParentCtl.Parent as TKOLControl); + FormCurrentParent := FormCurrentParentCtl.Name; + end; + end; + end; + end; KC.SetupFirst( SL, KC.RefName, OfParentName, Prefix ); KC.SetupName( SL, KC.RefName, OfParentName, Prefix ); // на случай, если // SetupFirst переопределена, и SetupName не вызвана - GenerateAdd2AutoFree( SL, KC.RefName, TRUE, '', KC ); + if FormCompact then + begin + KC.FAssignOnlyUserEvents := TRUE; + KC.AssignEvents( SL, KC.RefName ); + KC.FAssignOnlyUserEvents := FALSE; + end; + if FormCompact and KC.SupportsFormCompact then + //--// + else + GenerateAdd2AutoFree( SL, KC.RefName, TRUE, '', KC ); S := KC.RefName; - GenerateChildren( SL, KC, S, Prefix + ' ', Updated ); - if KC.fUpdated then - Updated := TRUE; + if (KC.ControlCount > 0) then + begin + if FormCompact then + begin + if not (KC is TKOLTabPage) + and not (KC is TKOLTabControl) then + begin + FormAddAlphabet( 'FormLastCreatedChildAsNewCurrentParent', FALSE, TRUE ); + FormCurrentParent := KC.Name; + FormCurrentParentCtl := KC; + end; + end; + GenerateChildren( SL, KC, S, Prefix + ' ', Updated ); + Rpt( 'children generated for ' + KC.Name, WHITE ); + end; + if KC.fUpdated then + begin + Updated := TRUE; + Rpt( 'updated TKOLForm', WHITE ); + end; end; finally L.Free; @@ -11333,7 +12215,7 @@ function TKOLForm.GenerateINC(const Path: String; var Updated: Boolean): Boolean result := ExtractFilePath( s ) + ExtractFileNameWOExt( s ); end; -var SL: TStringList; +var SL: TFormStringList; I, i1, i2: Integer; var MainMenuPresent: boolean; @@ -11348,6 +12230,10 @@ var //-------------------------- Generate_Pcode: Boolean; + s: String; + J, K: Integer; + ch: String; + FA: TStringList; begin asm jmp @@e_signature @@ -11373,6 +12259,7 @@ begin then Generate_Pcode := KOLProject.GeneratePCode else Generate_Pcode := FALSE; + Rpt( 'Start generate INC for ' + Path, WHITE ); //-- by Alexander Shakhaylo oc := TList.Create; TRY @@ -11385,6 +12272,7 @@ begin end; oc.Add(Owner.Components[ i ]); end; + Rpt( 'End generating components', WHITE ); SortData( oc, oc.Count, @CompareComponentOrder, @SwapComponents ); //OutSortedListOfComponents( UnitSourcePath + FormName, oc, 2 ); @@ -11413,7 +12301,8 @@ begin //-------------------------- - SL := TStringList.Create; + SL := TFormStringList.Create; + SL.OnAdd := DoFlushFormCompact; Result := False; TRY @@ -11428,6 +12317,7 @@ begin // Step 3. Generate , containing constructor of // form holder object. // + Rpt( 'add signature', WHITE ); SL.Add( Signature ); if Generate_Pcode then begin @@ -11450,6 +12340,7 @@ begin // Процедура создания объекта, сопоставленного форме. Вызывается // автоматически для автоматически создаваемых форм (и для главной // формы в первую очередь): + Rpt( 'add space', WHITE ); SL.Add( '' ); NeedOleInit := FALSE; @@ -11616,10 +12507,26 @@ begin // "Держатель формы" готов. Теперь конструируем саму форму. GenerateCreateForm( SL ); Log( 'after GenerateCreateForm, next: GenerateAdd2AutoFree' ); - GenerateAdd2AutoFree( SL, 'Result', FALSE, '', nil ); + //-- moved to GenerateCreateForm: GenerateAdd2AutoFree( SL, 'Result', FALSE, '', nil ); Log( 'after GenerateAdd2AutoFree, next: SetupFirst' ); //SL.Add( ' Result.Form.Add2AutoFree( Result );' ); + if FormCompact then + begin + //-------- move this code to GenerateCreateForm + { + SL.Add( ' //--< place to call FormCreateParameters >--//' ); + FreeAndNil( FFormAlphabet ); + FreeAndNil( FFormCtlParams ); + FFormAlphabet := TStringList.Create; + FFormCtlParams := TStringList.Create; + FFormCommandsAndParams := ''; + FormCurrentParent := ''; + FormCurrentCtlForTransparentCalls := ''; + } + FormFunArrayIdx := 0; + end; + FNameSetuped := FALSE; SetupFirst( SL, Result_Form, 'AParent', ' ' ); SetupName( SL, Result_Form, 'AParent', ' ' ); // @@ -11670,31 +12577,24 @@ begin begin MainMenuPresent := True; KO := TComponent( oc[ I ] ) as TKOLObj; - {if KO.CacheLines_SetupFirst <> nil then - begin - for i2 := 0 to KO.CacheLines_SetupFirst.Count-1 do - SL.Add( KO.CacheLines_SetupFirst[ i2 ] ); - end - else} - begin - i1 := SL.Count; + i1 := SL.Count; SL.Add( '' ); - //----------- + //----------- KO.FNameSetuped := FALSE; KO.SetupFirst( SL, 'Result.' + KO.Name, Result_Form, ' ' ); if not(KO is TKOLAction) then KO.SetupName( SL, 'Result.' + KO.Name, Result_Form, ' ' ); GenerateAdd2AutoFree( SL, 'Result.' + KO.Name, TRUE, '', KO ); KO.AssignEvents( SL, 'Result.' + KO.Name ); - //----------- - TRY - KO.CacheLines_SetupFirst := TStringList.Create; - for i2 := i1 to SL.Count-1 do + //----------- + if not FormCompact then + TRY + KO.CacheLines_SetupFirst := TStringList.Create; + for i2 := i1 to SL.Count-1 do KO.CacheLines_SetupFirst.Add( SL[ i2 ] ); - EXCEPT - FreeAndNil( KO.CacheLines_SetupFirst ); - END; - end; + EXCEPT + FreeAndNil( KO.CacheLines_SetupFirst ); + END; RptDetailed( 'SetupFirst & AssignEvents called for main menu', CYAN ); end else @@ -11726,11 +12626,12 @@ begin begin KO := TComponent( oc[ I ] ) as TKOLObj; KO.fUpdated := FALSE; - if (KO.CacheLines_SetupFirst <> nil) and - not ( KO is TKOLMenu ) then + if (KO.CacheLines_SetupFirst <> nil) + and not ( KO is TKOLMenu ) + and not ( FormCompact ) then begin - for i2 := 0 to KO.CacheLines_SetupFirst.Count-1 do - SL.Add( KO.CacheLines_SetupFirst[ i2 ] ); + for i2 := 0 to KO.CacheLines_SetupFirst.Count-1 do + SL.Add( KO.CacheLines_SetupFirst[ i2 ] ); end else begin @@ -11743,12 +12644,13 @@ begin GenerateAdd2AutoFree( SL, 'Result.' + KO.Name, FALSE, '', KO ); KO.AssignEvents( SL, 'Result.' + KO.Name ); //--- + if not FormCompact then TRY - KO.CacheLines_SetupFirst := TStringList.Create; - for i2 := i1 to SL.Count-1 do - KO.CacheLines_SetupFirst.Add( SL[ i2 ] ); + KO.CacheLines_SetupFirst := TStringList.Create; + for i2 := i1 to SL.Count-1 do + KO.CacheLines_SetupFirst.Add( SL[ i2 ] ); EXCEPT - FreeAndNil( KO.CacheLines_SetupFirst ); + FreeAndNil( KO.CacheLines_SetupFirst ); END; end; if KO.fUpdated then @@ -11762,6 +12664,9 @@ begin RptDetailed( 'start generating children', CYAN ); GenerateChildren( SL, Self, Result_Form, ' ', Updated ); RptDetailed( 'endof generating children', CYAN ); + Rpt( 'children generated for form', WHITE ); + //FormFlushCompact( SL ); + Rpt( 'form flushed compact', WHITE ); // По завершении первоначальной генерации выполняется еще один просмотр // всех контролов и объектов формы, и для них выполняется SetupLast - @@ -11784,17 +12689,73 @@ begin end; end; RptDetailed( 'endof generating SetupLast for children', CYAN ); + Rpt( 'setuplast generated for form', WHITE ); // Не забудем так же вызвать SetupLast для самой формы (можно было бы // всунуть код прямо сюда, но так будет легче потом сопровождать): SetupLast( SL, Result_Form, 'AParent', ' ' ); RptDetailed( 'endof generating SetupLast for a form', CYAN ); + //--- Если имелись контролы, создаваемые и настраиваемые компактным кодом + // то следует в заранее подготовленную позицию вставить вызов + // FormCreateParameters( alphabet, commands¶meters ); + // где: alphabet - массив указателей на использованные функции, + // commands¶meters - строка с командами и параметрами + // для интерпретации в вызовах FormExecuteCommands( ... ) + if FormCompact and (FFormAlphabet.Count > 0) then + begin + FA := TStringList.Create; + TRY + FA.Add( 'const FormFunctionsAlphabet: array[0..' + + //IntToStr( FFormAlphabet.Count-1 ) + '] of TFormInitFunc = (' ); + IntToStr( FFormAlphabet.Count-1 ) + '] of Pointer = (' ); + for J := 0 to FFormAlphabet.Count-1 do + begin + ch := '.'; + if FFormAlphabet.Objects[J] <> nil then + ch := '#'; + s := ' {' + Int2Hex( J+1, 1 ) + ch + '} @ ' + + FFormAlphabet[J]; + if J = FFormAlphabet.Count-1 then + s := s + ');' + else + s := s + ','; + FA.Add( s ); + end; + for J := SL.Count-1 downto 0 do + begin + if SL[J] = 'begin' then + begin + for K := FA.Count-1 downto 0 do + SL.Insert( J, FA[K] ); + break; + end; + end; + FINALLY + FA.Free; + END; + for I := 0 to SL.Count-1 do + begin + if SL[I] = ' //--< place to call FormCreateParameters >--//' then + begin + s := ' Result.Form.FormCreateParameters( ' + + '@ FormFunctionsAlphabet, ''''' + + FFormCommandsAndParams + ' );'; + //SL.SaveToFile( 'C:\test_SL_before.txt' ); + SL[ I ] := s; + //SL.SaveToFile( 'C:\test_SL.txt' ); + break; + end; + end; + end; + SL.Add( '' ); SL.Add( 'end;' ); if Generate_Pcode then {P}SL.Add( '{$ENDIF OldCode}' ); SL.Add( '' ); + FormFlushCompact( SL ); + if ResStrings <> nil then begin for I := ResStrings.Count-1 downto 0 do @@ -11931,8 +12892,9 @@ var SL: TStringList; // Source: TStringList; // исходный файл I, J, K: Integer; UsesFound, FormDefFound, ImplementationFound: Boolean; - S, S1, S2, S_FormClass, S_IFDEF_KOL_MCK, S_PROCEDURE_NEW, S_FUNCTION_NEW, S_Upper, - S_1, S_1_Lower, S_FormDef: AnsiString; + S: KOLString; + S1, S2, S_FormClass, S_IFDEF_KOL_MCK, S_PROCEDURE_NEW, S_FUNCTION_NEW, S_Upper, + S_1, S_1_Lower, S_FormDef: String; chg_src: Boolean; begin asm @@ -11999,7 +12961,8 @@ begin for I := 0 to Source.Count-2 do begin S := Trim( Source[ I ] ); - if (S <> '') and (S[ 1 ] = '{') and StrEq( S, '{$I MCKfakeClasses.inc}' ) then + if (S <> '') and (S[ 1 ] = '{') and + (AnsiCompareText( S, '{$I MCKfakeClasses.inc}' ) = 0) then if I < Source.Count - 5 then begin chg_src := TRUE; @@ -12066,7 +13029,7 @@ begin begin S := Source[I]; //S := StringReplace( S, '{$IF Defined(KOL_MCK)}{$ELSE}', '{$IFNDEF KOL_MCK}', [] ); - StrReplace( S, '{$IF Defined(KOL_MCK)}{$ELSE}', '{$IFNDEF KOL_MCK}' ); + KOLStrReplace( S, '{$IF Defined(KOL_MCK)}{$ELSE}', '{$IFNDEF KOL_MCK}' ); Source[I] := S; chg_src := TRUE; end; @@ -12075,7 +13038,7 @@ begin S := Source[I]; //S := StringReplace( S, '{$IFEND (place your units here->)}', // '{$ENDIF (place your units here->)}', [] ); - StrReplace( S, '{$IFEND (place your units here->)}', + KOLStrReplace( S, '{$IFEND (place your units here->)}', '{$ENDIF (place your units here->)}' ); Source[I] := S; chg_src := TRUE; @@ -12104,7 +13067,7 @@ begin begin S := Source[I]; //S := StringReplace( S, '{$IFNDEF KOL_MCK}', '{$IF Defined(KOL_MCK)}{$ELSE}', [ ] ); - StrReplace( S, '{$IFNDEF KOL_MCK}', '{$IF Defined(KOL_MCK)}{$ELSE}' ); + KOLStrReplace( S, '{$IFNDEF KOL_MCK}', '{$IF Defined(KOL_MCK)}{$ELSE}' ); Source[I] := S; chg_src := TRUE; end; @@ -12113,7 +13076,7 @@ begin S := Source[I]; //S := StringReplace( S, '{$ENDIF (place your units here->)}', // '{$IFEND (place your units here->)}', [] ); - StrReplace( S, '{$ENDIF (place your units here->)}', + KOLStrReplace( S, '{$ENDIF (place your units here->)}', '{$IFEND (place your units here->)}' ); Source[I] := S; chg_src := TRUE; @@ -12201,7 +13164,7 @@ begin end; end; if S_Upper = '{$IFDEF KOL_MCK}' then - if StrIsStartingFrom( PAnsiChar(AnsiString(UpperCase( Trim( Source[ I + 2 ] ) ))), + if StrIsStartingFrom( PChar(UpperCase( Trim( Source[ I + 2 ] ) )), 'PROCEDURE FREEOBJECTS_') then begin // remove artefact @@ -12230,7 +13193,7 @@ begin for I := 0 to Source.Count-3 do begin S := UpperCase( Trim( Source[ I ] ) ); - if StrIsStartingFrom( PAnsiChar( S ), '{$I MCKFAKECLASSES.INC}' ) then + if StrIsStartingFrom( PChar( S ), '{$I MCKFAKECLASSES.INC}' ) then begin for J := I+1 to Source.Count-3 do begin @@ -12304,7 +13267,8 @@ begin begin Inc( I ); - if StrEq( Trim( Source[ I ] ), 'implementation' ) then break; + if AnsiCompareText( Trim( Source[ I ] ), 'implementation' ) = 0 then + break; if (pos( 'uses ', LowerCase( Trim( Source[ I ] ) + ' ' ) ) = 1) then begin @@ -12318,7 +13282,8 @@ begin //S1 := 'uses Windows, Messages, ShellAPI, KOL' + AdditionalUnits; S1 := 'uses Windows, Messages, KOL' + AdditionalUnits; - S2 := Parse( S, '{' ); S := '{' + S; + S2 := {$IFDEF UNICODE_CTRLS} ParseW {$ELSE} Parse {$ENDIF} + ( S, '{' ); S := '{' + S; if not EqualWithoutSpaces( S1, S2 ) then begin @@ -12347,7 +13312,7 @@ begin if AfterGeneratePas( Source ) or chg_src then begin - SaveStrings( Source, Path + '.pas', Updated ); + SaveStrings( Source, Path + '.pas', Updated ); RptDetailed( 'Strings saved to ' + Path + '.pas', CYAN ); end else @@ -12571,9 +13536,14 @@ begin if not DoNotGenerateSetPosition then begin //Log( '#1.B TKOLForm.GenerateTransparentInits' ); + {$IFDEF _D2009orHigher} + Result := '.SetPosition( ' + IntToStr( (Owner as TForm).Left ) + ', ' + + IntToStr( (Owner as TForm).Top ) + ' )'; + {$ELSE} if FBounds <> nil then Result := '.SetPosition( ' + IntToStr( Bounds.Left ) + ', ' + IntToStr( Bounds.Top ) + ' )'; + {$ENDIF} //Log( '#1.C TKOLForm.GenerateTransparentInits' ); end; @@ -12586,11 +13556,21 @@ begin begin if {CanResize or} (Owner = nil) or not(Owner is TForm) then if HasCaption then + {$IFDEF _D2009orHigher} + Result := Result + '.SetSize( ' + IntToStr( (Owner as TForm).Width ) + ', ' + + IntToStr( (Owner as TForm).Height ) + ' )' + {$ELSE} Result := Result + '.SetSize( ' + IntToStr( Bounds.Width ) + ', ' + IntToStr( Bounds.Height ) + ' )' + {$ENDIF} else + {$IFDEF _D209orHigher} + Result := Result + '.SetSize( ' + IntToStr( Width ) + ', ' + + IntToStr( Height-GetSystemMetrics(SM_CYCAPTION) ) + ' )'; + {$ELSE} Result := Result + '.SetSize( ' + IntToStr( Bounds.Width ) + ', ' + IntToStr( Bounds.Height-GetSystemMetrics(SM_CYCAPTION) ) + ' )'; + {$ENDIF} end; //Log( '#3 TKOLForm.GenerateTransparentInits' ); @@ -12603,8 +13583,12 @@ begin //Log( '#4 TKOLForm.GenerateTransparentInits' ); - {if AllBtnReturnClick then - Result := Result + '.AllBtnReturnClick';} + if AllBtnReturnClick then + begin + if FormMain and not AppletOnForm then + else + Result := Result + '.AllBtnReturnClick'; + end; if PreventResizeFlicks then Result := Result + '.PreventResizeFlicks'; @@ -12735,7 +13719,7 @@ begin end; end; -function TKOLForm.GetFormName: String; +function TKOLForm.GetFormName: KOLString; begin asm jmp @@e_signature @@ -12756,10 +13740,10 @@ end; var LastSrcLocatedWarningTime: Integer; -function TKOLForm.GetFormUnit: String; +function TKOLForm.GetFormUnit: KOLString; var I, J: Integer; - S, S1, S2: String; + S, S1, S2: KOLString; Dpr: TStringList; begin asm @@ -13149,7 +14133,7 @@ begin end; end; -procedure TKOLForm.SetFormName(const Value: String); +procedure TKOLForm.SetFormName(const Value: KOLString); begin asm jmp @@e_signature @@ -13192,7 +14176,7 @@ begin end; -procedure TKOLForm.SetFormUnit(const Value: String); +procedure TKOLForm.SetFormUnit(const Value: KOLString); begin asm jmp @@e_signature @@ -13790,10 +14774,10 @@ const WindowStates: array[ KOL.TWindowState ] of String = ( 'wsNormal', var I: Integer; S: string; {YS} MainMenuHeight: Integer; - + C: String; {$IFDEF _D2009orHigher} - C, C2: WideString; - j : integer; + C2: WideString; + j : integer; {$ENDIF} begin asm @@ -13813,248 +14797,512 @@ begin // Установка каких-либо свойств формы - тех, которые выполняются // сразу после конструирования объекта формы: - SL.Add( '{$IFDEF UNICODE_CTRLS}' ); - SL.Add( ' Result.Form.SetUnicode(TRUE);' ); - SL.Add( '{$ENDIF UNICODE_CTRLS}' ); + if Unicode then + if FormCompact then + FormAddCtlCommand( 'Form', 'FormSetUnicode' ) + else + SL.Add( ' Result.Form.SetUnicode(TRUE);' ); SetupName( SL, AName, AParent, Prefix ); - if Tag <> 0 then + if Tag <> 0 then begin - if Tag < 0 then - SL.Add( Prefix + AName + '.Tag := DWORD(' + IntToStr( Tag ) + ');' ) - else - SL.Add( Prefix + AName + '.Tag := ' + IntToStr( Tag ) + ';' ); + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetTag' ); + FormAddNumParameter( Tag ); + end + else + if Tag < 0 then + SL.Add( Prefix + AName + '.Tag := DWORD(' + IntToStr( Tag ) + ');' ) + else + SL.Add( Prefix + AName + '.Tag := ' + IntToStr( Tag ) + ';' ); end; //Log( '&2 TKOLForm.SetupFirst' ); - if not statusSizeGrip then - //if (StatusText.Count > 0) or (SimpleStatusText <> '') then - SL.Add( Prefix + AName + '.SizeGrip := FALSE;' ); + if not statusSizeGrip then + if FormCompact then + FormAddCtlCommand( 'Form', 'FormSizeGripFalse' ) + else + SL.Add( Prefix + AName + '.SizeGrip := FALSE;' ); //Log( '&3 TKOLForm.SetupFirst' ); {YS} - S := ''; - case FborderStyle of - fbsDialog: - S := S + ' or WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE'; - fbsToolWindow: - S := S + ' or WS_EX_TOOLWINDOW'; + if FormCompact then + begin + I := 0; + case FborderStyle of + fbsDialog: I := I or WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE; + fbsToolWindow: I := I or WS_EX_TOOLWINDOW; + end; + if helpContextIcon then + I := I or WS_EX_CONTEXTHELP; + if I <> 0 then + begin + FormAddCtlCommand( 'Form', 'FormSetExStyle' ); + FormAddNumParameter( I ); + end; + end + else + begin + S := ''; + case FborderStyle of + fbsDialog: + S := S + ' or WS_EX_DLGMODALFRAME or WS_EX_WINDOWEDGE'; + fbsToolWindow: + S := S + ' or WS_EX_TOOLWINDOW'; + end; + + //Log( '&4 TKOLForm.SetupFirst' ); + + if helpContextIcon then + S := S + ' or WS_EX_CONTEXTHELP'; + if S <> '' then + SL.Add( Prefix + AName + '.ExStyle := ' + AName + '.ExStyle' + S + ';' ); end; - - //Log( '&4 TKOLForm.SetupFirst' ); - - if helpContextIcon then - S := S + ' or WS_EX_CONTEXTHELP'; - if S <> '' then - SL.Add( Prefix + AName + '.ExStyle := ' + AName + '.ExStyle' + S + ';' ); - //Log( '&5 TKOLForm.SetupFirst' ); {YS} - {if helpContextIcon then - SL.Add( Prefix + AName + '.ExStyle := ' + AName + '.ExStyle or WS_EX_CONTEXTHELP;' );} - if not Visible then - SL.Add( Prefix + AName + '.Visible := False;' ); - if not Enabled then - SL.Add( Prefix + AName + '.Enabled := False;' ); - if DoubleBuffered and not Transparent then - SL.Add( Prefix + AName + '.DoubleBuffered := True;' ); + if not Visible then + if FormCompact then + FormAddCtlCommand( 'Form', 'FormSetVisibleFalse' ) + else + SL.Add( Prefix + AName + '.Visible := False;' ); + + if not Enabled then + if FormCompact then + FormAddCtlCommand( 'Form', 'FormSetEnabledFalse' ) + else + SL.Add( Prefix + AName + '.Enabled := False;' ); + + if DoubleBuffered and not Transparent then + if FormCompact then + FormAddCtlCommand( 'Form', 'FormSetDoubleBufferedTrue' ) + else + SL.Add( Prefix + AName + '.DoubleBuffered := True;' ); {YS} //Log( '&6 TKOLForm.SetupFirst' ); - S := ''; - case FborderStyle of - fbsDialog: - S := S + ' and not (WS_MINIMIZEBOX or WS_MAXIMIZEBOX)'; - fbsToolWindow, fbsNone: - ; - else - begin - if not MinimizeIcon and not MaximizeIcon then - S := S + ' and not (WS_MINIMIZEBOX or WS_MAXIMIZEBOX)' - else - begin - if not MinimizeIcon then - S := S + ' and not WS_MINIMIZEBOX'; - if not MaximizeIcon then - S := S + ' and not WS_MAXIMIZEBOX'; - end; - end; - end; - - //Log( '&7 TKOLForm.SetupFirst' ); - //if not CanResize then - // S := S + ' and not WS_THICKFRAME'; - - if S <> '' then - SL.Add( Prefix + AName + '.Style := ' + AName + '.Style' + S + ';' ); - - if not DefaultSize then + if FormCompact then begin - if HasCaption then - begin - if HasMainMenu then - MainMenuHeight := GetSystemMetrics( SM_CYMENU ) + I := 0; + CASE FborderStyle OF + fbsDialog: I := I or WS_MINIMIZEBOX or WS_MAXIMIZEBOX; + fbsToolWindow, fbsNone: ; else - MainMenuHeight := 0; - if HasBorder then - SL.Add( Prefix + AName + '.SetClientSize( ' + IntToStr( (Owner as TForm).ClientWidth ) + - ', ' + IntToStr( (Owner as TForm).ClientHeight + MainMenuHeight ) + ' );' ); - end - //+++++++ UaFM + if not MinimizeIcon and not MaximizeIcon then + I := I or WS_MINIMIZEBOX or WS_MAXIMIZEBOX + else + begin + if not MinimizeIcon then + I := I or WS_MINIMIZEBOX; + if not MaximizeIcon then + I := I or WS_MAXIMIZEBOX; + end; + END; + if I <> 0 then + begin + FormAddCtlCommand( 'Form', 'FormResetStyles' ); + FormAddNumParameter( I ); + end; + end else - if HasBorder then - SL.Add( Prefix + AName + '.SetClientSize( ' + IntToStr( (Owner as TForm).ClientWidth ) + - ', ' + IntToStr( (Owner as TForm).ClientHeight-GetSystemMetrics(SM_CYCAPTION) ) - + ');' ); + begin + S := ''; + case FborderStyle of + fbsDialog: + S := S + ' and not (WS_MINIMIZEBOX or WS_MAXIMIZEBOX)'; + fbsToolWindow, fbsNone: + ; + else + begin + if not MinimizeIcon and not MaximizeIcon then + S := S + ' and not (WS_MINIMIZEBOX or WS_MAXIMIZEBOX)' + else + begin + if not MinimizeIcon then + S := S + ' and not WS_MINIMIZEBOX'; + if not MaximizeIcon then + S := S + ' and not WS_MAXIMIZEBOX'; + end; + end; + end; + + //Log( '&7 TKOLForm.SetupFirst' ); + //if not CanResize then + // S := S + ' and not WS_THICKFRAME'; + + if S <> '' then + SL.Add( Prefix + AName + '.Style := ' + AName + '.Style' + S + ';' ); end; - //if not CanResize then - // SL.Add( Prefix + AName + '.CanResize := FALSE;' ); + if not DefaultSize then + begin + if HasCaption then + begin + if HasMainMenu then + MainMenuHeight := GetSystemMetrics( SM_CYMENU ) + else + MainMenuHeight := 0; + if HasBorder then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetClientSize' ); + FormAddNumParameter( (Owner as TForm).ClientWidth ); + FormAddNumParameter( (Owner as TForm).ClientHeight + MainMenuHeight ); + end + else + SL.Add( Prefix + AName + '.SetClientSize( ' + + IntToStr( (Owner as TForm).ClientWidth ) + + ', ' + IntToStr( (Owner as TForm).ClientHeight + MainMenuHeight ) + ' );' ); + end + //+++++++ UaFM + else + if HasBorder then + if FormCompact then + begin + Form.FormAddCtlCommand( 'Form', 'FormSetClientSize' ); + Form.FormAddNumParameter( (Owner as TForm).ClientWidth ); + Form.FormAddNumParameter( (Owner as TForm).ClientHeight-GetSystemMetrics(SM_CYCAPTION) ); + end + else + SL.Add( Prefix + AName + '.SetClientSize( ' + + IntToStr( (Owner as TForm).ClientWidth ) + + ', ' + + IntToStr( (Owner as TForm).ClientHeight-GetSystemMetrics(SM_CYCAPTION) ) + + ');' ); + end; //Log( '&8 TKOLForm.SetupFirst' ); {YS} - if Transparent then - SL.Add( Prefix + AName + '.Transparent := True;' ); + if Transparent then + if FormCompact then + FormAddCtlCommand( Name, 'TControl.SetTransparent' ) // param = 1 + else + SL.Add( Prefix + AName + '.Transparent := True;' ); - if (AlphaBlend <> 255) and (AlphaBlend > 0) then - SL.Add( Prefix + AName + '.AlphaBlend := ' + IntToStr( AlphaBlend and $FF ) + ';' ); + if (AlphaBlend <> 255) and (AlphaBlend > 0) then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetAlphaBlend' ); + FormAddNumParameter( AlphaBlend and $FF ); + end + else + SL.Add( Prefix + AName + '.AlphaBlend := ' + IntToStr( AlphaBlend and $FF ) + ';' ); - if not HasBorder then + if not HasBorder then begin - SL.Add( Prefix + AName + '.HasBorder := False;' ); - SL.Add( Prefix + AName + '.SetClientSize( ' + IntToStr( (Owner as TForm).ClientWidth ) + - ', ' + IntToStr( (Owner as TForm).ClientHeight ) - + ');' ); + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetHasBorderFalse' ); + FormAddCtlCommand( 'Form', 'FormSetClientSize' ); + FormAddNumParameter( (Owner as TForm).ClientWidth ); + FormAddNumParameter( (Owner as TForm).ClientHeight ); + end + else + begin + SL.Add( Prefix + AName + '.HasBorder := False;' ); + SL.Add( Prefix + AName + '.SetClientSize( ' + + IntToStr( (Owner as TForm).ClientWidth ) + + ', ' + IntToStr( (Owner as TForm).ClientHeight ) + + ');' ); + end; end; - if not HasCaption and HasBorder then - SL.Add( Prefix + AName + '.HasCaption := False;' ); + if not HasCaption and HasBorder then + if FormCompact then + FormAddCtlCommand( 'Form', 'FormSetHasCaptionFalse' ) + else + SL.Add( Prefix + AName + '.HasCaption := False;' ); - if StayOnTop then - SL.Add( Prefix + AName + '.StayOnTop := True;' ); + if StayOnTop then + if FormCompact then + FormAddCtlCommand( 'Form', 'TControl.SetStayOnTop' ) + else + SL.Add( Prefix + AName + '.StayOnTop := True;' ); - if not Ctl3D then - SL.Add( Prefix + AName + '.Ctl3D := False;' ); + if not Ctl3D then + if FormCompact then + FormAddCtlCommand( 'Form', 'FormResetCtl3D' ) + else + SL.Add( Prefix + AName + '.Ctl3D := False;' ); - if Icon <> '' then + if Icon <> '' then begin - if Copy( Icon, 1, 1 ) = '#' then // +Alexander Pravdin - SL.Add( Prefix + AName + '.IconLoad( hInstance, MAKEINTRESOURCE( ' + - Copy( Icon, 2, Length( Icon ) - 1 ) + ' ) );' ) - else - if Copy( Icon, 1, 4 ) = 'IDI_' then - SL.Add( Prefix + AName + '.IconLoad( 0, ' + Icon + ' );' ) - else - if Copy( Icon, 1, 4 ) = 'IDC_' then - SL.Add( Prefix + AName + '.IconLoadCursor( 0, ' + Icon + ' );' ) - else - if Icon = '-1' then - SL.Add( Prefix + AName + '.Icon := THandle(-1);' ) - else - SL.Add( Prefix + AName + '.IconLoad( hInstance, ''' + Icon + ''' );' ); + if Copy( Icon, 1, 1 ) = '#' then // +Alexander Pravdin + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormIconLoad_hInstance' ); + FormAddNumParameter( StrToInt( Copy( Icon, 2, Length( Icon ) - 1 ) ) ) + end + else + SL.Add( Prefix + AName + '.IconLoad( hInstance, MAKEINTRESOURCE( ' + + Copy( Icon, 2, Length( Icon ) - 1 ) + ' ) );' ) + else + if Copy( Icon, 1, 4 ) = 'IDC_' then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormIconLoadCursor_0' ); + FormAddNumParameter( IDC2Number( Icon ) ); + end + else + SL.Add( Prefix + AName + '.IconLoadCursor( 0, MAKEINTRESOURCE(' + Icon + ') );' ) + else + if Copy( Icon, 1, 4 ) = 'IDI_' then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormIconLoadCursor_0' ); + FormAddNumParameter( IDI2Number( Icon ) ); + end + else + SL.Add( Prefix + AName + '.IconLoadCursor( 0, MAKEINTRESOURCE(' + Icon + ') );' ) + else + if Icon = '-1' then + if FormCompact then + FormAddCtlCommand( 'Form', 'FormSetIconNeg1' ) + else + SL.Add( Prefix + AName + '.Icon := THandle(-1);' ) + else + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormIconLoad_hInstance_str' ); + FormAddStrParameter( Icon ) + end + else + SL.Add( Prefix + AName + '.IconLoad( hInstance, ''' + Icon + ''' );' ); end; - if WindowState <> KOL.wsNormal then - SL.Add( Prefix + AName + '.WindowState := ' + WindowStates[ WindowState ] + + if WindowState <> KOL.wsNormal then + if FormCompact then + begin + if Integer( WindowState ) = 1 then + begin + FormAddCtlCommand( 'Form', 'TControl.SetWindowState' ); + // param = 1 + end + else + begin + FormAddCtlCommand( 'Form', 'FormSetWindowState' ); + FormAddNumParameter( Integer( WindowState ) ); + end; + end + else + SL.Add( Prefix + AName + '.WindowState := ' + WindowStates[ WindowState ] + ';' ); - if Trim( Cursor ) <> '' then + if Trim( Cursor ) <> '' then begin - if Copy( Cursor, 1, 4 ) = 'IDC_' then - SL.Add( Prefix + AName + '.CursorLoad( 0, ' + Cursor + ' );' ) - else - SL.Add( Prefix + AName + '.CursorLoad( hInstance, ''' + Trim( Cursor ) + ''' );' ); + if Copy( Cursor, 1, 4 ) = 'IDC_' then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormCursorLoad_0' ); + FormAddNumParameter( IDC2Number( Cursor ) ); + end + else + SL.Add( Prefix + AName + '.CursorLoad( 0, ' + Cursor + ' );' ) + else + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormCursorLoad_hInstance' ); + FormAddStrParameter( Trim( Cursor ) ); + end + else + SL.Add( Prefix + AName + '.CursorLoad( hInstance, ''' + Trim( Cursor ) + ''' );' ); end; - if Brush <> nil then - Brush.GenerateCode( SL, AName ); + if Brush <> nil then + Brush.GenerateCode( SL, AName ); - if (Font <> nil) then + if (Font <> nil) then begin - if FontDefault and (KOLProject <> nil) then - Font.Assign(KOLProject.DefaultFont); - if not Font.Equal2( nil ) then - Font.GenerateCode( SL, AName, nil ); + if FontDefault and (KOLProject <> nil) + and Assigned(KOLProject.DefaultFont) + and not KOLProject.DefaultFont.Equal2(nil) + and not KOLProject.DefaultFont.Equal2(Font) then + begin + Rpt( 'KOLProject font is assigned to form.Font', WHITE ); + Font.Assign(KOLProject.DefaultFont); + Rpt( 'KOLProject font was assigned to form.Font', WHITE ); + end; + if not Font.Equal2( nil ) then + begin + Font.GenerateCode( SL, AName, nil ); + Rpt( 'form font code generated', WHITE ); + end; end; - if Border <> 2 then - SL.Add( Prefix + AName + '.Border := ' + IntToStr( Border ) + ';' ); + if Border <> 2 then + if FormCompact then + begin + if Border = 1 then + begin + FormAddCtlCommand( 'Form', 'TControl.SetBorder' ); + // param = 1 + end + else + begin + FormAddCtlCommand( 'Form', 'FormSetBorder' ); + FormAddNumParameter( Border ); + end; + end else + SL.Add( Prefix + AName + '.Border := ' + IntToStr( Border ) + ';' ); - if MarginTop <> 0 then - SL.Add( Prefix + AName + '.MarginTop := ' + IntToStr( MarginTop ) + ';' ); + if MarginTop <> 0 then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetMarginTop' ); + FormAddNumParameter( MarginTop ); + end else + SL.Add( Prefix + AName + '.MarginTop := ' + IntToStr( MarginTop ) + ';' ); - if MarginBottom <> 0 then - SL.Add( Prefix + AName + '.MarginBottom := ' + IntToStr( MarginBottom ) + ';' ); + if MarginBottom <> 0 then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetMarginBottom' ); + FormAddNumParameter( MarginBottom ); + end else + SL.Add( Prefix + AName + '.MarginBottom := ' + IntToStr( MarginBottom ) + ';' ); - if MarginLeft <> 0 then - SL.Add( Prefix + AName + '.MarginLeft := ' + IntToStr( MarginLeft ) + ';' ); + if MarginLeft <> 0 then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetMarginLeft' ); + FormAddNumParameter( MarginLeft ); + end else + SL.Add( Prefix + AName + '.MarginLeft := ' + IntToStr( MarginLeft ) + ';' ); - if MarginRight <> 0 then - SL.Add( Prefix + AName + '.MarginRight := ' + IntToStr( MarginRight ) + ';' ); + if MarginRight <> 0 then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetMarginRight' ); + FormAddNumParameter( MarginRight ); + end else + SL.Add( Prefix + AName + '.MarginRight := ' + IntToStr( MarginRight ) + ';' ); + + RptDetailed( 'margins ready', WHITE ); if (FStatusText <> nil) and (FStatusText.Text <> '') then begin - if FStatusText.Count = 1 then - begin - {$IFDEF _D2009orHigher} - C := FStatusText[ 0 ]; - C2 := ''; - for j := 1 to Length(C) do C2 := C2 + '#'+int2str(ord(C[j])); - C := C2; - SL.Add( Prefix + AName + '.SimpleStatusText := ' + C + ';' ); - {$ELSE} - SL.Add( Prefix + AName + '.SimpleStatusText := ' + - PCharStringConstant( Self, 'SimpleStatusText', FStatusText[ 0 ] ) + ';' ); - {$ENDIF} - end + if FStatusText.Count = 1 then + begin + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetSimpleStatusText' ); + FormAddStrParameter( FStatusText[ 0 ] ); + end else + begin + {$IFDEF _D2009orHigher} + C := FStatusText[ 0 ]; + C2 := ''; + for j := 1 to Length(C) do C2 := C2 + '#'+int2str(ord(C[j])); + C := C2; + {$ELSE} + C := PCharStringConstant( Self, 'SimpleStatusText', FStatusText[ 0 ] ); + {$ENDIF} + SL.Add( Prefix + AName + '.SimpleStatusText := ' + C + ';' ); + end; + end else begin - for I := 0 to FStatusText.Count-1 do - begin - {$IFDEF _D2009orHigher} - C := FStatusText[ I ]; - C2 := ''; - for j := 1 to Length(C) do C2 := C2 + '#'+int2str(ord(C[j])); - C := C2; - SL.Add( Prefix + AName + '.StatusText[ ' + IntToStr( I ) + ' ] := ' + C + ';' ); - {$ELSE} - SL.Add( Prefix + AName + '.StatusText[ ' + IntToStr( I ) + ' ] := ' + - PCharStringConstant( Self, 'StatusText' + IntToStr( I ), FStatusText[ I ] ) + ';' ); - {$ENDIF} - end; - end; + for I := 0 to FStatusText.Count-1 do + begin + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetStatusText' ); + FormAddNumParameter( I ); + FormAddStrParameter( FStatusText[ I ] ); + end else + begin + {$IFDEF _D2009orHigher} + C := FStatusText[ I ]; + C2 := ''; + for j := 1 to Length(C) do + C2 := C2 + '#'+int2str(ord(C[j])); + C := C2; + {$ELSE} + C := PCharStringConstant( Self, 'StatusText' + IntToStr( I ), FStatusText[ I ] ); + {$ENDIF} + SL.Add( Prefix + AName + '.StatusText[ ' + IntToStr( I ) + ' ] := ' + C + ';' ); + end; + end; + end; end; - if not CloseIcon then + if not CloseIcon then begin - SL.Add( Prefix + 'DeleteMenu( GetSystemMenu( Result.Form.GetWindowHandle, ' + + if FormCompact then + FormAddCtlCommand( 'Form', 'FormRemoveCloseIcon' ) + else + SL.Add( Prefix + 'DeleteMenu( GetSystemMenu( Result.Form.GetWindowHandle, ' + 'False ), SC_CLOSE, MF_BYCOMMAND );' ); end; + if EraseBackground then + if FormCompact then + FormAddCtlCommand( 'Form', 'FormSetEraseBkgndTrue' ) + else + SL.Add( Prefix + AName + '.EraseBackground := TRUE;' ); + + if MinWidth > 0 then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetMinWidth' ); + FormAddNumParameter( MinWidth ); + end else + SL.Add( Prefix + AName + '.MinWidth := ' + IntToStr( MinWidth ) + ';' ); + + if MinHeight > 0 then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetMinHeight' ); + FormAddNumParameter( MinHeight ); + end else + SL.Add( Prefix + AName + '.MinHeight := ' + IntToStr( MinHeight ) + ';' ); + + if MaxWidth > 0 then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetMaxWidth' ); + FormAddNumParameter( MaxWidth ); + end else + SL.Add( Prefix + AName + '.MaxWidth := ' + IntToStr( MaxWidth ) + ';' ); + + if MaxHeight > 0 then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetMaxHeight' ); + FormAddNumParameter( MaxHeight ); + end else + SL.Add( Prefix + AName + '.MaxHeight := ' + IntToStr( MaxHeight ) + ';' ); + + if KeyPreview then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetKeyPreviewTrue' ); + end else + SL.Add( Prefix + AName + '.KeyPreview := TRUE;' ); + + if AllBtnReturnClick then + begin + if FormMain and not AppletOnForm then + begin + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'TControl.AllBtnReturnClick' ); + end else + SL.Add( Prefix + AName + '.AllBtnReturnClick;' ); + end; + end; + RptDetailed( 'Before AssignEvents for form', WHITE ); + + FAssignOnlyUserEvents := FALSE; + FAssignOnlyWinEvents := FALSE; AssignEvents( SL, AName ); - if EraseBackground then - SL.Add( Prefix + AName + '.EraseBackground := TRUE;' ); - - if MinWidth > 0 then - SL.Add( Prefix + AName + '.MinWidth := ' + IntToStr( MinWidth ) + ';' ); - - if MinHeight > 0 then - SL.Add( Prefix + AName + '.MinHeight := ' + IntToStr( MinHeight ) + ';' ); - - if MaxWidth > 0 then - SL.Add( Prefix + AName + '.MaxWidth := ' + IntToStr( MaxWidth ) + ';' ); - - if MaxHeight > 0 then - SL.Add( Prefix + AName + '.MaxHeight := ' + IntToStr( MaxHeight ) + ';' ); - - if KeyPreview then - SL.Add( Prefix + AName + '.KeyPreview := TRUE;' ); + RptDetailed( 'After AssignEvents for form', WHITE ); LogOK; finally @@ -14077,38 +15325,64 @@ begin if not FLocked then begin - S := ''; - if CenterOnScreen then - S := Prefix + AName + '.CenterOnParent'; - if not CanResize then - begin - if S = '' then - S := Prefix + AName; - S := S + '.CanResize := False' - end; - if S <> '' then - SL.Add( S + ';' ); + S := ''; + if CenterOnScreen then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'TControl.CenterOnParent' ); + end else + S := Prefix + AName + '.CenterOnParent'; - if not CanResize or not MinimizeIcon or not MaximizeIcon then - SL.Add( Prefix + AName + '.Perform( WM_INITMENU, 0, 0 );' ); + if not CanResize then + begin + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormSetCanResizeFalse' ); + end + else + begin + if S = '' then + S := Prefix + AName; + S := S + '.CanResize := False' + end; + end; + if (S <> '') and not FormCompact then + SL.Add( S + ';' ); - if MinimizeNormalAnimated then - SL.Add( Prefix + AName + '.MinimizeNormalAnimated;' ) - else - if RestoreNormalMaximized then - SL.Add( Prefix + AName + '.RestoreNormalMaximized;' ); + if not CanResize or not MinimizeIcon or not MaximizeIcon then + if FormCompact then + begin + FormAddCtlCommand( 'Form', 'FormInitMenu' ); + end else + SL.Add( Prefix + AName + '.Perform( WM_INITMENU, 0, 0 );' ); - if Assigned( FpopupMenu ) then - SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name + - ' );' ); - if @ OnFormCreate <> nil then - begin - SL.Add( Prefix + 'Result.' + (Owner as TForm).MethodName( @ OnFormCreate ) + '( Result );' ); - end; - {YS} - if FborderStyle = fbsDialog then - SL.Add( Prefix + AName + '.Icon := THandle(-1);' ); - {YS} + if MinimizeNormalAnimated then + if FormCompact then + FormAddCtlCommand( 'Form', 'TControl.MinimizeNormalAnimated' ) + else + SL.Add( Prefix + AName + '.MinimizeNormalAnimated;' ) + else + if RestoreNormalMaximized then + if FormCompact then + FormAddCtlCommand( 'Form', 'TControl.RestoreNormalMaximized' ) + else + SL.Add( Prefix + AName + '.RestoreNormalMaximized;' ); + + if Assigned( FpopupMenu ) then + SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name + + ' );' ); + + if @ OnFormCreate <> nil then + begin + SL.Add( Prefix + 'Result.' + (Owner as TForm).MethodName( @ OnFormCreate ) + '( Result );' ); + end; + {YS} + if FborderStyle = fbsDialog then + if FormCompact then + FormAddCtlCommand( 'Form', 'FormSetIconNeg1' ) + else + SL.Add( Prefix + AName + '.Icon := THandle(-1);' ); + {YS} end; LogOK; @@ -14140,6 +15414,23 @@ begin end; end; +procedure TKOLForm.Set_Bounds(const Value: TFormBounds); +begin + if (fBounds.Left=Value.Left) + and (fBounds.Top =Value.Top ) + and (fBounds.Width = Value.Width) + and (fBounds.Height= Value.Height) then + Exit; + fBounds := Value; + if Owner is TCustomForm then + begin + (Owner as TCustomForm).Left := Value.Left; + (Owner as TCustomForm).Top := Value.Top; + (Owner as TCustomForm).Width:= Value.Width; + (Owner as TCustomForm).Height := Value.Height; + end; +end; + procedure TKOLForm.Set_Color(const Value: TColor); begin asm @@ -14516,8 +15807,9 @@ end; procedure TKOLForm.GenerateCreateForm(SL: TStringList); var + C: String; {$IFDEF _D2009orHigher} - C, C2: WideString; + C2: WideString; i : integer; {$ENDIF} S: String; @@ -14531,8 +15823,6 @@ begin Log( '->TKOLForm.GenerateCreateForm' ); try - S := GenerateTransparentInits; - {$IFDEF _D2009orHigher} C := StringConstant( 'Caption', Caption ); if C <> '''''' then @@ -14541,20 +15831,53 @@ begin for i := 2 to Length(C) - 1 do C2 := C2 + '#'+int2str(ord(C[i])); C := C2; end; - SL.Add( ' Result.Form := NewForm( AParent, ' + C + - ' )' + S + ';' ); {$ELSE} - SL.Add( ' Result.Form := NewForm( AParent, ' + StringConstant( 'Caption', Caption ) + - ' )' + S + ';' ); + C := StringConstant( 'Caption', Caption ); {$ENDIF} + if FormCompact then + begin + SL.Add( ' Result.Form := NewForm( AParent, ' + C + + ' )' + S + ';' ); + // Если форма главная, и Applet не используется, инициализировать здесь + // переменную Applet: + if FormMain and not AppletOnForm then + SL.Add( ' Applet := Result.Form;' ); + SL.Add( ' Result.Form.DF.FormAddress := @ Result.Form;' ); + SL.Add( ' Result.Form.DF.FormObj := Result;' ); + GenerateAdd2AutoFree( SL, 'Result', FALSE, '', nil ); + + if FormMain and AppletOnForm and (Applet <> nil) then + Applet.AssignEvents( SL, 'Applet' ); + + SL.Add( ' //--< place to call FormCreateParameters >--//' ); + FreeAndNil( FFormAlphabet ); + FreeAndNil( FFormCtlParams ); + FFormAlphabet := TStringList.Create; + FFormCtlParams := TStringList.Create; + FFormCommandsAndParams := ''; + FormCurrentParent := ''; + FormCurrentParentCtl := nil; + FormCurrentCtlForTransparentCalls := 'Form'; + GenerateTransparentInits_Compact; + FormFlushedUntil := 0; + FormIndexFlush := 0; + FreeAndNil( FormControlsList ); + end + else + begin + S := GenerateTransparentInits; + SL.Add( ' Result.Form := NewForm( AParent, ' + C + + ' )' + S + ';' ); + // Если форма главная, и Applet не используется, инициализировать здесь + // переменную Applet: + if FormMain and not AppletOnForm then + SL.Add( ' Applet := Result.Form;' ); + GenerateAdd2AutoFree( SL, 'Result', FALSE, '', nil ); + end; + if @ OnBeforeCreateWindow <> nil then SL.Add( ' Result.' + (Owner as TForm).MethodName( @ OnBeforeCreateWindow ) + '( Result );' ); - // Если форма главная, и Applet не используется, инициализировать здесь - // переменную Applet: - if FormMain and not AppletOnForm then - SL.Add( ' Applet := Result.Form;' ); - LogOK; finally Log( '<-TKOLForm.GenerateCreateForm' ); @@ -14762,10 +16085,10 @@ begin LogOK; Exit; end; - if Add2AutoFreeProc = '' then - Add2AutoFreeProc := 'Add2AutoFree'; - if not AControl then - SL.Add( ' Result.Form.' + Add2AutoFreeProc + '( ' + AName + ' );' ); + if Add2AutoFreeProc = '' then + Add2AutoFreeProc := 'Add2AutoFree'; + if not AControl then + SL.Add( ' Result.Form.' + Add2AutoFreeProc + '( ' + AName + ' );' ); LogOK; finally @@ -16552,19 +17875,20 @@ procedure TKOLForm.SetupName(SL: TStringList; const AName, AParent, Prefix: String); begin if FNameSetuped then Exit; - if Name <> '' then + if (Name <> '') and GenerateCtlNames then begin - SL.Add( ' {$IFDEF USE_NAMES}' ); - // Maybe Data module - - if AName <> 'nil' {can be 'Result.Form'} then // this control placed NOT on datamodule - SL.Add( Prefix + AName + '.SetName( ' + {'Result.Form'} 'Applet' + ', ''' + Owner.Name + ''' );') - else // not on form - Sl.Add(Format( '%sResult.SetName( Result, ''%s'' ); ', [Prefix, Owner.Name])); - - - SL.Add( ' {$ENDIF}' ); - FNameSetuped := TRUE; + if FormCompact and (AName <> 'nil') then + begin + FormAddCtlCommand( 'Form', 'FormSetName' ); + FormAddStrParameter( Owner.Name ); + end + else + if AName <> 'nil' {can be 'Result.Form'} then // this control placed NOT on datamodule + SL.Add( Prefix + AName + '.SetName( ' + {'Result.Form'} 'Applet' + ', ''' + Owner.Name + ''' );') + // Applet используется для хранения имен форм! + else // not on form + SL.Add(Format( '%sResult.SetName( Result, ''%s'' ); ', [Prefix, Owner.Name])); + FNameSetuped := TRUE; end; end; @@ -16606,8 +17930,11 @@ begin if not FLocked then begin - FRestoreNormalMaximized := Value; - Change( Self ); + if FRestoreNormalMaximized <> Value then + begin + FRestoreNormalMaximized := Value; + Change( Self ); + end; end; LogOK; @@ -16641,6 +17968,456 @@ begin Change( Self ); end; +procedure TKOLForm.SetFormCompact(const Value: Boolean); +begin + FFormCompact := Value; + Change( Self ); +end; + +function TKOLForm.FormAddAlphabet(const funname: String; creates_ctrl, add_call: Boolean): Integer; +begin + if FFormAlphabet = nil then + FFormAlphabet := TStringList.Create; + Result := FFormAlphabet.IndexOf( funname ); + if Result < 0 then + begin + Result := FFormAlphabet.Count; + FFormAlphabet.AddObject( funname, Pointer(Integer( creates_ctrl )) ); + end; + if add_call then + begin + if creates_ctrl then + begin + FFormCommandsAndParams := FFormCommandsAndParams + #13#10 + + ' +{' + funname + '}'#9 + EncodeFormNumParameter( -Result-1 ); + end + else + begin + FFormCommandsAndParams := FFormCommandsAndParams + #13#10 + + ' +{' + funname + '}'#9 + EncodeFormNumParameter( Result+1 ); + end; + end; +end; + +procedure TKOLForm.FormAddCtlParameter(const S: String); +begin + if FFormCtlParams = nil then + FFormCtlParams := TStringList.Create; + FFormCtlParams.Add( S ); +end; + +procedure TKOLForm.FormAddNumParameter(N: Integer); +begin + FFormCommandsAndParams := FFormCommandsAndParams + EncodeFormNumParameter( N ); +end; + +procedure TKOLForm.FormAddStrParameter(const S: String); +var i: Integer; + in_q: Boolean; + special: Boolean; +begin + FFormCommandsAndParams := FFormCommandsAndParams + + EncodeFormNumParameter( Length( S ) ) + ''''; + in_q := TRUE; + for i := 1 to Length( S ) do + begin + special := S[I] < ' '; + {$IFDEF _D2009orHigher} + if Byte(S[I]) >= 128 then + special := TRUE; + {$ELSE} + if (Byte(S[I]) >= 128) and not(S[I] in ['А'..'Я', 'а'..'я', 'Ё', 'ё']) then + special := TRUE; + {$ENDIF} + if special then + begin + if in_q then + FFormCommandsAndParams := FFormCommandsAndParams + ''''; + in_q := FALSE; + FFormCommandsAndParams := FFormCommandsAndParams + '#' + Int2Str(Byte(S[I])); + end + else + begin + if not in_q then + FFormCommandsAndParams := FFormCommandsAndParams + ''''; + in_q := TRUE; + FFormCommandsAndParams := FFormCommandsAndParams + S[I]; + end; + end; + if in_q then + FFormCommandsAndParams := FFormCommandsAndParams + ''''; +end; + +procedure TKOLForm.FormAddCtlCommand(const CtlName, FunName: String); +var i: Integer; + C: TComponent; +begin + if (CtlName <> '') + and (FormCurrentCtlForTransparentCalls <> CtlName) then + begin + //FormAddCtlParameter( CtlName ); + //FormCurrentCtlForTransparentCalls := CtlName; + C := Owner.FindComponent( CtlName ); + if (C <> nil) and (C is TKOLTabPage) + and ((C as TKOLTabPage).Parent is TKOLTabControl) then + begin + FormAddAlphabet( 'FormSetCurCtl', FALSE, TRUE ); + i := FormIndexOfControl( (C as TKOLTabPage).Parent.Name ); + FormAddNumParameter( i ); + FormCurrentCtlForTransparentCalls := (C as TKOLTabPage).Parent.Name; + FormAddAlphabet( 'FormSetTabpageAsParent', FALSE, TRUE ); + i := ((C as TKOLTabPage).Parent as TKOLTabControl).IndexOfPage( CtlName ); + FormAddNumParameter( i ); + FormCurrentParent := CtlName; + FormCurrentParentCtl := C as TKOLControl; + end + else + begin + FormAddAlphabet( 'FormSetCurCtl', FALSE, TRUE ); + i := FormIndexOfControl( CtlName ); + FormAddNumParameter( i ); + FormCurrentCtlForTransparentCalls := CtlName; + end; + end; + FormAddAlphabet( FunName, FALSE, TRUE ); +end; + +procedure TKOLForm.FormFlushCompact(SL: TFormStringList); +var i, j: Integer; + s: String; + //UL: TStringList; + //CL: TStringList; + AL: TStringList; +begin + if not FormCompact then Exit; + if FormFlushedCompact then + Exit; + if IsFormFlushing then Exit; + IsFormFlushing := TRUE; + TRY + SL.OnAdd := nil; + inc( FormIndexFlush ); + + Rpt( 'FormFlushCompact ' + IntToStr( FormIndexFlush ), YELLOW ); + RptDetailed( CopyTail( FFormCommandsAndParams, 100 ), CYAN ); + Rpt_Stack; + + {LogFileOutput( 'C:\BuggMCK+cp.txt', '--------------------- flush ' + + IntToStr( FormIndexFlush ) + #13#10 + SL.Text + #13#10 + + '-------------------- cmds¶ms on flush ' + IntToStr( FormIndexFlush ) + + ': ' + FFormCommandsAndParams);} + FFormCommandsAndParams := FFormCommandsAndParams + #13#10' +#0 {' + + 'flush:' + IntToStr( FormIndexFlush ) + '}'; + + {LogFileOutput( 'C:\BuggMCK.txt', '--------------------- flush ' + + IntToStr( FormIndexFlush ) + #13#10 + SL.Text );} + + if (FFormCtlParams = nil) or (FFormCtlParams.Count = 0) then + SL.Add( ' Result.Form.FormExecuteCommands( nil, nil ); ' + + '// flush: ' + IntToStr( FormIndexFlush ) ) + else + begin + {UL := TStringList.Create; + CL := TStringList.Create; + TRY} + s := UnitSourcePath + FormUnit + '.pas'; + //SL.Add( '// Loading from ' + s ); + //UL.LoadFromFile( s ); + //if UL.Count > 0 then + if FileExists( s ) then + begin + {for i := 0 to UL.Count-1 do + begin + if Trim( UL[i] ) = 'Form: PControl;' then + begin + //SL.Add( '// Form: PControl was found in line ' + IntToStr(i) ); + CL.Add( 'Form' ); + for j := i+4 to UL.Count-1 do + begin + s := Trim( UL[j] ); + if pos( ':', s ) <= 0 then break; + CL.Add( Trim( Parse( s, ':' ) ) ); + end; + break; + end; + end;} + + inc( FormFunArrayIdx ); + SL.Add( ' Result.Form.FormExecuteCommands( @ Result.Form, ' + + '@ FormControlsArray' + IntToStr( FormFunArrayIdx ) + '[0]);' + + '// flush: ' + IntToStr( FormIndexFlush ) ); + AL := TStringList.Create; + TRY + AL.Add( 'const FormControlsArray' + IntToStr( FormFunArrayIdx ) + + ': array[0..' + + IntToStr( FFormCtlParams.Count-1 ) + + '] of SmallInt = (' ); + for i := 0 to FFormCtlParams.Count-1 do + begin + j := //CL.IndexOf( FFormCtlParams[i] ); + FormIndexOfControl( FFormCtlParams[i] ); + s := Int2Str(j) + ' {' + FFormCtlParams[i] + '}'; + if i < FFormCtlParams.Count-1 then + s := s + ',' + else + s := s + ' );'; + AL.Add( ' ' + s ); + end; + for i := SL.Count-1 downto 0 do + begin + s := SL[i]; + if s = 'begin' then + begin + for j := AL.Count-1 downto 0 do + SL.Insert( i, AL[j] + ' // -- ' + IntToStr(j) ); + break; + end; + end; + FINALLY + AL.Free; + END; + + end; + + {if CL.Count = 0 then + begin + SL.Add( '// Source Unit not found!!!' ); + SL.Add( ' Result.Form.FormExecuteCommands( @ Result.Form, [ ' ); + for i := 0 to FFormCtlParams.Count-1 do + begin + s := '(Integer(@ Result.' + FFormCtlParams[i] + + ') - Integer(@ Result.Form) ) div 4'; + if i < FFormCtlParams.Count-1 then + s := s + ',' + else + s := s + ' ] );'; + SL.Add( ' ' + s ); + end; + end;} + {FINALLY + UL.Free; + CL.Free; + END;} + + FFormCtlParams.Clear; + end; + //SL.Add( '// flush: ' + IntToStr( FormIndexFlush ) ); + FormFlushedUntil := Length( FFormCommandsAndParams ); + + {LogFileOutput( 'C:\BuggMCKafter.txt', '--------------------- flushed ' + + IntToStr( FormIndexFlush ) + #13#10 + SL.Text );} + + SL.OnAdd := DoFlushFormCompact; + FINALLY + IsFormFlushing := FALSE; + END; +end; + +procedure TKOLForm.SetGenerateCtlNames(const Value: Boolean); +begin + FGenerateCtlNames := Value; +end; + +function TKOLForm.FormFlushedCompact: Boolean; +begin + Result := Length( FFormCommandsAndParams ) <= FormFlushedUntil; +end; + +procedure TKOLForm.SetUnicode(const Value: Boolean); +begin + FUnicode := Value; + Change( Self ); +end; + +procedure TKOLForm.DoFlushFormCompact(Sender: TObject); +begin + FormFlushCompact( Sender as TFormStringList ); +end; + +procedure TKOLForm.GenerateTransparentInits_Compact; +begin + asm + jmp @@e_signature + DB '#$signature$#', 0 + DB 'TKOLForm.GenerateTransparentInits_Compact', 0 + @@e_signature: + end; + Log( '->TKOLForm.GenerateTransparentInits_Compact' ); + try + if not FLocked then + begin + + if not DefaultPosition then + begin + if not DoNotGenerateSetPosition then + begin + if FBounds <> nil then + begin + FormAddCtlCommand( 'Form', 'FormSetPosition' ); + FormAddNumParameter( Bounds.Left ); + FormAddNumParameter( Bounds.Top ); + end; + end; + + end; + + if not DefaultSize then + begin + if (Owner = nil) or not(Owner is TForm) then + if HasCaption then + begin + FormAddCtlCommand( 'Form', 'FormSetSize' ); + FormAddNumParameter( Bounds.Width ); + FormAddNumParameter( Bounds.Height ); + end + else + begin + FormAddCtlCommand( 'Form', 'FormSetSize' ); + FormAddNumParameter( Bounds.Width ); + FormAddNumParameter( Bounds.Height - GetSystemMetrics(SM_CYCAPTION) ); + end; + end; + + if Tabulate then + FormAddCtlCommand( 'Form', 'TControl.Tabulate' ) + else + if TabulateEx then + FormAddCtlCommand( 'Form', 'TControl.TabulateEx' ); + + if PreventResizeFlicks then + FormAddCtlCommand( 'Form', 'TControl.PreventResizeFlicks' ); + + if supportMnemonics then + FormAddCtlCommand( 'Form', 'TControl.SupportMnemonics' ); + + if HelpContext <> 0 then + begin + FormAddCtlCommand( 'Form', 'FormAssignHelpContext' ); + FormAddNumParameter( HelpContext ); + end; + end; + + LogOK; + finally + Log( '<-TKOLForm.GenerateTransparentInits_Compact' ); + end; +end; + +function TKOLForm.EncodeFormNumParameter(I: Integer): String; +var //II: Integer; + b: Byte; + Buffer: array[ 0..4 ] of Byte; + k, j: Integer; + Sign: Boolean; +begin + //II := I; + + k := 0; + if I = 0 then + begin + k := 1; + Buffer[0] := 0; + end + else + begin + Sign := FALSE; + if I < 0 then + begin + I := -I; + Sign := TRUE; + end; + while I <> 0 do + begin + if k = 0 then + begin + b := I shl 2; + if Sign then + b := b or 2; + I := I shr 6; + end + else + begin + b := I shl 1; + I := I shr 7; + end; + Buffer[k] := b; + inc( k ); + end; + end; + + Result := ''; // '+{' + Format( '%03d', [ II ] ) + '}'; + for j := k-1 downto 0 do + begin + b := Buffer[j]; + if j > 0 then + b := b or 1; + Result := Result + '#$' + Int2Hex( b, 2 ); + end; + + { + Result := ''; + if I < 0 then + II := (Int64( -I ) shl 1) or 1 + else + //if I > 0 then + II := Int64( I ) shl 1; + if II = 0 then + begin + Result := Result + '#$00'; + end + else + while II <> 0 do + begin + b := II and $7F; + II := II shr 7; + if II <> 0 then + b := b or $80; + Result := Result + '#$' + Int2Hex( b, 2 ); + end; + } +end; + +function TKOLForm.FormIndexOfControl(const CtlName: String): Integer; +var s: KOLString; + UL: TStringList; + i, j: Integer; +begin + if FormControlsList = nil then + begin + RptDetailed( 'Loading source of ' + FormUnit, WHITE ); + FormControlsList := TStringList.Create; + s := UnitSourcePath + FormUnit + '.pas'; + UL := TStringList.Create; + TRY + LoadSource( UL, s ); + RptDetailed( 'source loaded, searching Form: PControl', WHITE ); + for i := 0 to UL.Count-1 do + begin + if Trim( UL[i] ) = 'Form: PControl;' then + begin + FormControlsList.Add( 'Form' ); + for j := i+4 to UL.Count-1 do + begin + s := Trim( UL[j] ); + if pos( ':', s ) <= 0 then break; + FormControlsList.Add( Trim( Parse( s, ':' ) ) ); + end; + break; + end; + end; + FINALLY + UL.Free; + END; + end; + RptDetailed( 'searching ' + CtlName, WHITE ); + Result := FormControlsList.IndexOf( CtlName ); +end; + +procedure TKOLForm.SetOverrideScrollbars(const Value: Boolean); +begin + FOverrideScrollbars := Value; +end; + { TKOLProject } procedure TKOLProject.AfterGenerateDPR(const SL: TStringList; var Updated: Boolean); @@ -16752,7 +18529,7 @@ function TKOLProject.ConvertVCL2KOL( ConfirmOK: Boolean; ForceAllForms: Boolean var I, E, N: Integer; F: TKolForm; S, E_reason: String; - tmp: AnsiString; + tmp: String; Color: Integer; begin asm @@ -16831,8 +18608,8 @@ begin begin tmp := '/S "' + IncludeTrailingPathDelimiter( ProjectSourcePath ) + ProjectDest + '.exe"'; - I := ShellExecuteA( 0, nil, PAnsiChar( CallPCompiler ), - PAnsiChar(tmp), PAnsiChar( AnsiString(ProjectSourcePath) ), SW_HIDE ); + I := ShellExecute( 0, nil, PChar( CallPCompiler ), + PChar(tmp), PChar( ProjectSourcePath ), SW_HIDE ); Rpt( 'Called pcompiler: ' + IntToStr( I ), GREEN ); end; end @@ -16974,7 +18751,7 @@ var I, J: Integer; FI: TIFormInterface; FCI, CI: TIComponentInterface; KindDefined: Boolean; - S, ObjName, ObjType: AnsiString; + S, ObjName, ObjType: KOLString; SL: TStringList; begin asm @@ -17009,7 +18786,7 @@ begin FCI.GetPropValueByName( 'Name', S ); //Rpt( 'Form component interface obtained for ' + FName + // ', Name=' + S + ' (Unit=' + UN + ')', WHITE ); - if StrEq( S, FName ) then + if AnsiCompareText( S, FName ) = 0 then for J := 0 to FCI.GetComponentCount-1 do begin CI := FCI.GetComponent( J ); @@ -17048,17 +18825,17 @@ begin for J := 0 to SL.Count-1 do begin S := Trim( SL[ J ] ); - if StrIsStartingFrom( PAnsiChar( S ), 'object ' ) then + if StrIsStartingFrom( PKOLChar( S ), 'object ' ) then begin Parse( S, AnsiString(' ') ); ObjName := Trim( Parse( S, ':' ) ); ObjType := Trim( S ); if J = 0 then begin - if not StrEq( ObjName, FName ) then + if AnsiCompareText( ObjName, FName ) <> 0 then begin - Rpt( 'Another form - - continue', WHITE ); - break; + Rpt( 'Another form - - continue', WHITE ); + break; end; end; if (ObjType = 'TKOLMDIClient') then @@ -17072,7 +18849,7 @@ begin begin if not KindDefined and (ObjType = 'TKOLMDIChild') and - StrIsStartingFrom( PAnsiChar( S ), 'ParentMDIForm = ' ) then + StrIsStartingFrom( PKOLChar( S ), 'ParentMDIForm = ' ) then begin Rpt( 'TKOLMDIChild found for ' + FName + ' in dfm', WHITE ); Result := fkMDIChild; @@ -17120,7 +18897,7 @@ procedure ReorderForms( Prj: TKOLProject; Forms: TStringList ); var Rslt: TStringList; I, J: Integer; FormName, Name2, ParentFormName: String; - S: AnsiString; + S: KOLString; Kind: TFormKind; begin asm @@ -17166,7 +18943,7 @@ begin if TFormKind( Forms.Objects[ J ] ) = fkMDIChild then begin S := Name2; - Parse( S, ',' ); + {$IFDEF UNICODE_CTRLS} ParseW {$ELSE} Parse {$ENDIF} ( S, ',' ); if CompareText( S, FormName ) = 0 then begin Rslt.Add( Name2 ); @@ -17190,7 +18967,7 @@ function TKOLProject.GenerateDPR(const Path: String): Boolean; const BeginMark = 'begin // PROGRAM START HERE -- Please do not remove this comment'; BeginResourceStringsMark = '// RESOURCE STRINGS START HERE -- Please do not change this section'; var SL, Source, AForms: TStringList; - A, S, S1, FM: AnsiString; + A, S, S1, FM: KOLString; I, J: Integer; F: TKOLForm; Found: Boolean; @@ -17319,10 +19096,10 @@ var SL, Source, AForms: TStringList; if (HelpFile <> '') and not IsDLL then begin - if StrEq( ExtractFileExt( HelpFile ), '.chm' ) then - SL.Add( ' AssignHtmlHelp( ' + StringConstant( 'HelpFile', HelpFile ) + ' );' ) + if AnsiCompareText( ExtractFileExt( HelpFile ), '.chm' ) = 0 then + SL.Add( ' AssignHtmlHelp( ' + StringConstant( 'HelpFile', HelpFile ) + ' );' ) else - SL.Add( ' Applet.HelpPath := ' + StringConstant( 'HelpFile', HelpFile ) + ';' ); + SL.Add( ' Applet.HelpPath := ' + StringConstant( 'HelpFile', HelpFile ) + ';' ); end; if not IsDLL then begin @@ -17427,7 +19204,7 @@ var SL, Source, AForms: TStringList; for I := 0 to AForms.Count - 1 do begin S := AForms[ I ]; - S := Trim( Parse( S, ',' ) ); + S := Trim( {$IFDEF UNICODE_CTRLS} ParseW {$ELSE} Parse {$ENDIF} ( S, ',' ) ); F := nil; for J := 0 to FormsList.Count - 1 do begin @@ -17600,14 +19377,14 @@ begin end; if Kol_added then begin - J := pos( 'KOL,', S ); + J := IndexOfStr( S, 'KOL,' ); //pos( 'KOL,', S ); if J > 0 then begin S := Copy( S, 1, J-1 ) + Copy( S, J+4, Length( S )-J-3 ); if Trim( S ) = '' then continue; end; end; - J := pos( 'Forms,', S ); + J := IndexOfStr( S, 'Forms,' ); // pos( 'Forms,', S ); if J > 0 then // remove reference to Forms.pas begin S := Copy( S, 1, J-1 ) + Copy( S, J+6, Length( S )-J-5 ); @@ -17878,7 +19655,7 @@ begin END; end; -function TKOLProject.GetProjectDest: AnsiString; +function TKOLProject.GetProjectDest: String; begin asm jmp @@e_signature @@ -17909,7 +19686,7 @@ begin END; end; -function TKOLProject.GetProjectName: AnsiString; +function TKOLProject.GetProjectName: String; var I: Integer; {$IFDEF _D2005orHigher} @@ -18277,7 +20054,7 @@ var w: DWORD; {$IFDEF REPORT_TIME} s: String; {$ENDIF} - tmp: AnsiString; + tmp: String; begin asm jmp @@e_signature @@ -18305,7 +20082,7 @@ begin LastColor := Color; end; tmp := Txt + #10; - WriteConsole( FOut, PAnsiChar(tmp), Length( Txt ) + 1, w, nil ); + WriteConsole( FOut, PChar(tmp), Length( Txt ) + 1, w, nil ); end; if ShowReport and Building then ShowMessage( Txt ); @@ -18430,7 +20207,7 @@ begin END; end; -procedure TKOLProject.SetCallPCompiler(const Value: AnsiString); +procedure TKOLProject.SetCallPCompiler(const Value: String); begin FCallPCompiler := Value; end; @@ -18489,7 +20266,7 @@ begin Change; end; -procedure TKOLProject.SetHelpFile(const Value: AnsiString); +procedure TKOLProject.SetHelpFile(const Value: String); begin if FHelpFile = Value then Exit; Log( '->TKOLProject.SetHelpFile' ); @@ -18713,7 +20490,7 @@ begin END; end; -procedure TKOLProject.SetProjectDest(const Value: AnsiString); +procedure TKOLProject.SetProjectDest(const Value: String); begin asm jmp @@e_signature @@ -19308,7 +21085,7 @@ begin begin if EventHandlers[ I ] <> nil then begin - SL.Add( ' ' + AName + '.' + AnsiString(EventNames[ I ]) + ' := Result.' + + SL.Add( ' ' + AName + '.' + String(EventNames[ I ]) + ' := Result.' + ParentForm.MethodName( EventHandlers[ I ] ) + ';' ); // TODO: KOL_ANSI end; end; @@ -19435,14 +21212,14 @@ begin Success := False; for I := 1 to Length( NameNew ) do begin - if NameNew[ I ] in [ '0'..'9' ] then - begin - Success := True; - N := StrToInt( Copy( NameNew, I, Length( NameNew ) - I + 1 ) ); - Inc( N ); - NameNew := Copy( NameNew, 1, I - 1 ) + IntToStr( N ); - break; - end; + if (NameNew[ I ] >= '0') and (NameNew[ I ] <= '9') then + begin + Success := True; + N := StrToInt( Copy( NameNew, I, Length( NameNew ) - I + 1 ) ); + Inc( N ); + NameNew := Copy( NameNew, 1, I - 1 ) + IntToStr( N ); + break; + end; end; if not Success then break; end; @@ -19651,16 +21428,16 @@ begin begin {P}SL.Add( ' LoadSELF Load4 ####T' + (Owner as TForm).Name + '.' + (Owner as TForm).MethodName( EventHandlers[ I ] ) ); - {P}SL.Add( ' C2 T' + TypeName + '_.Set' + AnsiString(EventNames[ I ]) + '<1>' + {P}SL.Add( ' C2 T' + TypeName + '_.Set' + String(EventNames[ I ]) + '<1>' ); // TODO: KOL_ANSI end else begin {P}SL.Add( ' Load4 ####T' + (Owner as TForm).Name + '.' + (Owner as TForm).MethodName( EventHandlers[ I ] ) ); - {P}SL.Add( ' C1 AddWord_Store ##T' + TypeName + '_.f' + AnsiString(EventNames[ I ]) ); // TODO: KOL_ANSI + {P}SL.Add( ' C1 AddWord_Store ##T' + TypeName + '_.f' + String(EventNames[ I ]) ); // TODO: KOL_ANSI {P}SL.Add( ' LoadSELF C1 AddWord_Store ##(4+T' + TypeName + '_.f' + - AnsiString(EventNames[ I ]) + ')' ); // TODO: KOL_ANSI + String(EventNames[ I ]) + ')' ); // TODO: KOL_ANSI end; end; end; @@ -19725,7 +21502,7 @@ procedure TKOLObj.P_ProvideFakeType(SL: TStrings; var i: Integer; begin for i := 0 to SL.Count-1 do - if StrEq( SL[ i ], Declaration ) then Exit; + if AnsiCompareText( SL[ i ], Declaration ) = 0 then Exit; SL.Insert( 1, Declaration ); end; @@ -19994,6 +21771,9 @@ var BFont: TKOLFont; S: String; FontPname: String; Lines: Integer; + KF: TKOLForm; + Ctl_Name: String; + fs: TFontStyles; procedure AddLine( const S: String ); begin @@ -20017,47 +21797,114 @@ begin if AFont = nil then BFont := TKOLFont.Create( nil ); + KF := nil; + Ctl_Name := ''; + if fOwner <> nil then + if fOwner is TKOLForm then + begin + KF := fOwner as TKOLForm; + Ctl_Name := 'Form'; + end + else if fOwner is TKOLCustomControl then + begin + KF := (fOwner as TKOLCustomControl).ParentKOLForm; + if KF <> nil then + Ctl_Name := (fOwner as TKOLCustomControl).Name; + end; + FontPname := 'Font'; Lines := 0; - if (fOwner <> nil) and (fOwner is TKOLCustomControl) then - FontPname := (fOwner as TKOLCustomControl).FontPropName; + if (fOwner <> nil) and (fOwner is TKOLCustomControl) then + FontPname := (fOwner as TKOLCustomControl).FontPropName; + + if Color <> BFont.Color then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Ctl_Name, 'FormSetFontColor' ); + KF.FormAddNumParameter( (Color shl 1) or (Color shr 31) ); + end + else + AddLine( 'Color := TColor(' + Color2Str( Color ) + ')' ); - if Color <> BFont.Color then - AddLine( 'Color := TColor(' + Color2Str( Color ) + ')' ); if FontStyle <> BFont.FontStyle then begin - S := ''; - if fsBold in TFontStyles( FontStyle ) then - S := ' fsBold,'; - if fsItalic in TFontStyles( FontStyle ) then - S := S + ' fsItalic,'; - if fsStrikeout in TFontStyles( FontStyle ) then - S := S + ' fsStrikeOut,'; - if fsUnderline in TFontStyles( FontStyle ) then - S := S + ' fsUnderline,'; - if S <> '' then - S := Trim( Copy( S, 1, Length( S ) - 1 ) ); - AddLine( 'FontStyle := [ ' + S + ' ]' ); + if (KF <> nil) and KF.FormCompact then + begin + fs := FontStyle; + KF.FormAddCtlCommand( Ctl_Name, 'FormSetFontStyles' ); + KF.FormAddNumParameter( PByte( @fs )^ ); + end + else + begin + S := ''; + if fsBold in TFontStyles( FontStyle ) then + S := ' fsBold,'; + if fsItalic in TFontStyles( FontStyle ) then + S := S + ' fsItalic,'; + if fsStrikeout in TFontStyles( FontStyle ) then + S := S + ' fsStrikeOut,'; + if fsUnderline in TFontStyles( FontStyle ) then + S := S + ' fsUnderline,'; + if S <> '' then + S := Trim( Copy( S, 1, Length( S ) - 1 ) ); + AddLine( 'FontStyle := [ ' + S + ' ]' ); + end; end; - if FontHeight <> BFont.FontHeight then - AddLine( 'FontHeight := ' + IntToStr( FontHeight ) ); - if FontWidth <> BFont.FontWidth then - AddLine( 'FontWidth := ' + IntToStr( FontWidth ) ); - if FontName <> BFont.FontName then - AddLine( 'FontName := ''' + FontName + '''' ); - if FontOrientation <> BFont.FontOrientation then - AddLine( 'FontOrientation := ' + IntToStr( FontOrientation ) ); - if FontCharset <> BFont.FontCharset then - AddLine( 'FontCharset := ' + IntToStr( FontCharset ) ); - if FontPitch <> BFont.FontPitch then - AddLine( 'FontPitch := ' + FontPitches[ FontPitch ] ); - if AFont = nil then - BFont.Free; + if FontHeight <> BFont.FontHeight then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Ctl_Name, 'FormSetFontHeight' ); + KF.FormAddNumParameter( FontHeight ); + end else + AddLine( 'FontHeight := ' + IntToStr( FontHeight ) ); - if Lines > 0 then - if (fOwner <> nil) and (fOwner is TKOLCustomControl) then - (fOwner as TKOLCustomControl).AfterFontChange( SL, AName, ' ' ); + if FontWidth <> BFont.FontWidth then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Ctl_Name, 'FormSetFontWidth' ); + KF.FormAddNumParameter( FontWidth ); + end else + AddLine( 'FontWidth := ' + IntToStr( FontWidth ) ); + + if FontName <> BFont.FontName then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Ctl_Name, 'FormSetFontName' ); + KF.FormAddStrParameter( FontName ); + end else + AddLine( 'FontName := ''' + FontName + '''' ); + + if FontOrientation <> BFont.FontOrientation then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Ctl_Name, 'FormSetFontOrientation' ); + KF.FormAddNumParameter( FontOrientation ); + end else + AddLine( 'FontOrientation := ' + IntToStr( FontOrientation ) ); + + if FontCharset <> BFont.FontCharset then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Ctl_Name, 'FormSetFontCharset' ); + KF.FormAddNumParameter( FontCharset ); + end else + AddLine( 'FontCharset := ' + IntToStr( FontCharset ) ); + + if FontPitch <> BFont.FontPitch then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( Ctl_Name, 'FormSetFontPitch' ); + KF.FormAddNumParameter( Integer( FontPitch ) ); + end else + AddLine( 'FontPitch := ' + FontPitches[ FontPitch ] ); + + if AFont = nil then + BFont.Free; + + if Lines > 0 then + if (fOwner <> nil) and (fOwner is TKOLCustomControl) then + (fOwner as TKOLCustomControl).AfterFontChange( SL, AName, ' ' ); end; procedure TKOLFont.P_GenerateCode(SL: TStrings; const AName: String; AFont: TKOLFont); @@ -21296,17 +23143,6 @@ begin if S <> '' then //SL.Add( S + ';' ); {P}SL.Add( S ); - (* ... for a frame, this is not applicable ... - if MinimizeNormalAnimated then - //SL.Add( Prefix + AName + '.MinimizeNormalAnimated;' ); - begin - {P}SL.Add( ' DUP TControl.MinimizeNormalAnimated<1>' ) - end - else - begin - SL.Add( ' DUP TControl.RestoreNormalMaximized<1>' ) - end; - *) if Assigned( FpopupMenu ) then //SL.Add( Prefix + AName + '.SetAutoPopupMenu( Result.' + FpopupMenu.Name + // ' );' ); @@ -23007,7 +24843,7 @@ begin U := Caption; {$IFDEF _D2009orHigher} C2 := ''; - for j := 1 to Length(U) do C2 := C2 + '#'+int2str(ord(U[j])); + for j := 1 to Length(U) do C2 := C2 + '#'+IntToStr(ord(U[j])); U := C2; {$ENDIF} if (U = '') or (Faction <> nil) then @@ -23296,35 +25132,6 @@ begin begin RptDetailed( 'Menu ' + Name + ' has no event attached', RED ); end; - (*F := MenuComponent.ParentForm; -////////////////////////////////////////////////////////////////////////////////// - {$IFDEF _D6orHigher} // - if (F <> nil) and (F.Designer <> nil) then // - begin // - F.Designer.QueryInterface( IDesigner, FD ); // - if FD <>nil then // - //if F.Designer.QueryInterface( IFormDesigner, FD ) = 0 then // - if FOnMenuMethodName <> '' then - if FD.MethodExists( FOnMenuMethodName ) then // - begin - RptDetailed( 'Menu ' + MenuName + '.AssignEvents: ' + - FOnMenuMethodName ); - SL.Add( ' ' + MenuName + '.AssignEvents( ' + IntToStr( ItemIndex ) + // - ', [ Result.' + FOnMenuMethodName + ' ] );' ); // - end; - end; // - {$ELSE} // -////////////////////////////////////////////////////////////////////////////////// - if (F <> nil) and (F.Designer <> nil) then - if QueryFormDesigner( F.Designer, FD ) then - //if F.Designer.QueryInterface( IFormDesigner, FD ) = 0 then - if FD.MethodExists( FOnMenuMethodName ) then - SL.Add( ' ' + MenuName + '.AssignEvents( ' + IntToStr( ItemIndex ) + - ', [ Result.' + FOnMenuMethodName + ' ] );' ); -////////////////////////////////////////////////////////////////////////////////// - {$ENDIF} // -////////////////////////////////////////////////////////////////////////////////// - *) end; if (Accelerator.Key <> vkNotPresent) and (Faction = nil) then begin @@ -24983,47 +26790,99 @@ const 'bsFDiagonal', 'bsBDiagonal', 'bsCross', 'bsDiagCross' ); var RsrcName: String; Updated: Boolean; + KF: TKOLForm; + i: Integer; begin if FOwner = nil then Exit; if FOwner is TKOLForm then begin - if Bitmap.Empty then - begin - case BrushStyle of - bsSolid: if (FOwner as TKOLForm).Color <> clBtnFace then - SL.Add( ' ' + AName + '.Color := TColor(' + Color2Str( (FOwner as TKOLForm).Color ) + ');' ); - else SL.Add( ' ' + AName + '.Brush.BrushStyle := ' + BrushStyles[ BrushStyle ] + ';' ); + KF := FOwner as TKOLForm; + if Bitmap.Empty then + begin + case BrushStyle of + bsSolid: if KF.Color <> clBtnFace then + if KF.FormCompact then + begin + KF.FormAddCtlCommand( 'Form', 'FormSetColor' ); + KF.FormAddNumParameter( (KF.Color shl 1) or (KF.Color shr 31) ); + end + else + SL.Add( ' ' + AName + '.Color := TColor(' + Color2Str( KF.Color ) + ');' ); + else if KF.FormCompact then + begin + KF.FormAddCtlCommand( 'Form', 'FormSetBrushStyle' ); + KF.FormAddNumParameter( Integer( BrushStyle ) ); + end + else + SL.Add( ' ' + AName + '.Brush.BrushStyle := ' + BrushStyles[ BrushStyle ] + ';' ); + end; + end + else + begin + RsrcName := (FOwner as TKOLForm).Owner.Name + '_' + + (FOwner as TKOLForm).Name + '_BRUSH_BMP'; + GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated ); + if KF.FormCompact then + begin + (SL as TFormStringList).OnAdd := nil; + SL.Add( ' {$R ' + RsrcName + '.res}' ); + (SL as TFormStringList).OnAdd := KF.DoFlushFormCompact; + KF.FormAddCtlCommand( 'Form', 'FormSetBrushBitmap' ); + KF.FormAddStrParameter( UpperCase( RsrcName ) ); + end + else + begin + SL.Add( ' {$R ' + RsrcName + '.res}' ); + SL.Add( ' ' + AName + '.Brush.BrushBitmap := ' + + 'LoadBmp( hInstance, ''' + UpperCase( RsrcName ) + + ''', Result );' ); + end; end; - end - else - begin - RsrcName := (FOwner as TKOLForm).Owner.Name + '_' + - (FOwner as TKOLForm).Name + '_BRUSH_BMP'; - SL.Add( ' {$R ' + RsrcName + '.res}' ); - GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated ); - SL.Add( ' ' + AName + '.Brush.BrushBitmap := LoadBmp( hInstance, ''' + UpperCase( RsrcName ) - + ''', Result );' ); - end; end else if FOwner is TKOLCustomControl then begin + KF := (FOwner as TKOLCustomControl).ParentKOLForm; if Bitmap.Empty then begin case BrushStyle of - bsSolid: if not (FOwner as TKOLCustomControl).ParentColor then - SL.Add( ' ' + AName + '.Color := TColor(' + Color2Str( (FOwner as TKOLForm).Color ) + ');' ); - else SL.Add( ' ' + AName + '.Brush.BrushStyle := ' + BrushStyles[ BrushStyle ] + ';' ); + bsSolid: if not (FOwner as TKOLCustomControl).ParentColor then + if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( (FOwner as TKOLCustomControl).Name, 'FormSetColor' ); + i := (FOwner as TKOLCustomControl).Color; + KF.FormAddNumParameter( (i shl 1) or (i shr 31) ); + end + else + SL.Add( ' ' + AName + '.Color := TColor(' + Color2Str( (FOwner as TKOLCustomControl).Color ) + ');' ); + else if (KF <> nil) and KF.FormCompact then + begin + KF.FormAddCtlCommand( (FOwner as TKOLCustomControl).Name, 'FormSetBrushStyle' ); + KF.FormAddNumParameter( Integer( BrushStyle ) ); + end + else + SL.Add( ' ' + AName + '.Brush.BrushStyle := ' + BrushStyles[ BrushStyle ] + ';' ); end; end else begin RsrcName := (FOwner as TKOLCustomControl).ParentForm.Name + '_' + (FOwner as TKOLCustomControl).Name + '_BRUSH_BMP'; - SL.Add( ' {$R ' + RsrcName + '.res}' ); GenerateBitmapResource( Bitmap, UPPERCASE( RsrcName ), RsrcName, Updated ); - SL.Add( ' ' + AName + '.Brush.BrushBitmap := LoadBmp( hInstance, ''' + UpperCase( RsrcName ) - + ''', Result );' ); + if (KF <> nil) and KF.FormCompact then + begin + (SL as TFormStringList).OnAdd := nil; + SL.Add( ' {$R ' + RsrcName + '.res}' ); + (SL as TFormStringList).OnAdd := KF.DoFlushFormCompact; + KF.FormAddCtlCommand( (FOwner as TKOLCustomControl).Name, 'FormSetBrushBitmap' ); + KF.FormAddStrParameter( UpperCase( RsrcName ) ); + end + else + begin + SL.Add( ' {$R ' + RsrcName + '.res}' ); + SL.Add( ' ' + AName + '.Brush.BrushBitmap := LoadBmp( hInstance, ''' + + UpperCase( RsrcName ) + ''', Result );' ); + end; end; end; end; @@ -25785,6 +27644,24 @@ begin end; +{ TFormStringList } + +function TFormStringList.Add(const s: String): Integer; +begin + if not FCallingOnAdd and Assigned( OnAdd ) then + begin + FCallingOnAdd := TRUE; + OnAdd( Self ); + FCallingOnAdd := FALSE; + end; + Result := inherited Add(s); +end; + +procedure TFormStringList.SetOnAdd(const Value: TNotifyEvent); +begin + FOnAdd := Value; +end; + initialization Log( 'I n i t i a l i z a t i o n' ); {$IFDEF DEBUG_MCK} diff --git a/read1st.txt b/read1st.txt index 9710548..18e6445 100644 --- a/read1st.txt +++ b/read1st.txt @@ -3,7 +3,7 @@ KEY OBJECTS LIBRARY for Delphi (and Free Pascal Compiler) - to make applications Copyright (C) by Vladimir Kladov, 1999-2010. Some parts of code are Copyright (C) intellectual property by other people, see comments in code and on KOL site. Thanks to all for help with KOL and MCK! -v. 2.90 (27-Mar-2010) +v. 3.00 (3-Oct-2010) To get newer version, go to Web-page http://www.kolmck.net and get there updates. diff --git a/read1st_rus.txt b/read1st_rus.txt index 290fca9..70cd7b0 100644 --- a/read1st_rus.txt +++ b/read1st_rus.txt @@ -1,7 +1,7 @@ KEY OBJECTS LIBRARY для Delphi (и Free Pascal Compiler) - предназначен для того, чтобы сделать программы, изготовленные с использованием языка Паскаль, маленькими и очень маленькими. Copyright (C) by Vladimir Kladov, 1999-2007. Бесплатно, с исходными текстами. -версия 2.90 (27 марта 2010 г.) +версия 2.93 (3 июня 2010 г.) _________________ КРАТКОЕ ОПИСАНИЕ: diff --git a/visual_xp_styles.inc b/visual_xp_styles.inc index edbfd84..a2457c8 100644 --- a/visual_xp_styles.inc +++ b/visual_xp_styles.inc @@ -1,6 +1,6 @@ // Name: KOL Addon - Visual XP Styles -// Rev.: 1.98 -// Date: 04 may 2010 +// Rev.: 1.99 + KOL 3.00.A +// Date: 02 oct 2010 // Author: MTsv DN // Thanks: mdw, Vladimir Kladov @@ -168,9 +168,9 @@ var Bmp : HBITMAP; begin // Checking user owner-draw - if Assigned(Sender.fOnPaint) and (@Sender.fOnPaint <> @WndSplitterXPDraw) then + if Assigned(Sender.EV.fOnPaint) and (@Sender.EV.fOnPaint <> @WndSplitterXPDraw) then begin - Sender.fOnPaint(Sender, DC); + Sender.EV.fOnPaint(Sender, DC); exit; end; @@ -182,18 +182,19 @@ begin DeleteObject(Brush); // Creating brush and pen - if Sender.fPressed then - begin - Bmp := CreateBitmap(2, 2, 1, 1, @Bit); - B := CreatePatternBrush(Bmp); - fDC := SelectObject(DC, B); - // Drawing splitter - PatBlt (DC, 0, 0, Sender.Width, Sender.Height, PATINVERT); - // Destroying brush and pen - SelectObject(DC, fDC); - DeleteObject(B); - DeleteObject(Bmp); - end; + if {$IFDEF USE_FLAGS} G4_Pressed in Sender.fFlagsG4 + {$ELSE} Sender.fPressed {$ENDIF} then + begin + Bmp := CreateBitmap(2, 2, 1, 1, @Bit); + B := CreatePatternBrush(Bmp); + fDC := SelectObject(DC, B); + // Drawing splitter + PatBlt (DC, 0, 0, Sender.Width, Sender.Height, PATINVERT); + // Destroying brush and pen + SelectObject(DC, fDC); + DeleteObject(B); + DeleteObject(Bmp); + end; end; //*************************** Drawing TabControl Page ************************// procedure WndTabXPDraw( Dummy : Pointer; Sender: PControl; DC: HDC ); @@ -204,9 +205,9 @@ var fDC : HDC; begin // Checking user owner-draw - if Assigned(Sender.fOnPaint) and (@Sender.fOnPaint <> @WndTabXPDraw) then + if Assigned(Sender.EV.fOnPaint) and (@Sender.EV.fOnPaint <> @WndTabXPDraw) then begin - Sender.fOnPaint(Sender, DC); + Sender.EV.fOnPaint(Sender, DC); exit; end; hThemes := OpenThemeData(Sender.fHandle, 'TAB'); @@ -244,9 +245,9 @@ var Pen : HPEN; begin // Checking user owner-draw - if Assigned(Sender.fOnPaint) and (@Sender.fOnPaint <> @WndPanelXPDraw) then + if Assigned(Sender.EV.fOnPaint) and (@Sender.EV.fOnPaint <> @WndPanelXPDraw) then begin - Sender.fOnPaint(Sender, DC); + Sender.EV.fOnPaint(Sender, DC); exit; end; @@ -270,16 +271,18 @@ begin end; // Draw back layer - if (Sender.fedgeStyle = esTransparent) or (Sender.fTransparent) then else + if (Sender.EdgeStyle = esTransparent) or + ({$IFDEF USE_FLAGS} (G2_Transparent in Sender.fFlagsG2) + {$ELSE} Sender.fTransparent {$ENDIF}) then else begin Brush := CreateSolidBrush(Color2RGB(Sender.fParent.Color)); fDC1 := SelectObject(DC, Brush); FillRect(DC, RClient, Brush); - case Sender.fedgeStyle of + case Sender.EdgeStyle of esRaised, esLowered: begin - Sender.fStyle := Sender.fStyle and (not SS_SUNKEN) and (not WS_DLGFRAME); + Sender.fStyle.Value := Sender.fStyle.Value and (not SS_SUNKEN) and (not WS_DLGFRAME); Sender.fExStyle := Sender.fExStyle and (not WS_EX_STATICEDGE) or WS_EX_WINDOWEDGE; Pen := CreatePen(PS_SOLID, 1, Color2RGB(clLtGrey)); @@ -299,12 +302,16 @@ begin begin hThemes := OpenThemeData(Sender.fHandle, 'button'); Color := Sender.Font.Color; - if hThemes <> 0 then - begin - if not Sender.fEnabled then - GetThemeColor(hThemes, 1, 4, 3803, Color); - CloseThemeData(hThemes); - end; + if hThemes <> 0 then + begin + {$IFDEF USE_FLAGS} + if (F3_Disabled in Sender.fStyle.f3_Style) then + {$ELSE} + if not Sender.fEnabled then + {$ENDIF} + GetThemeColor(hThemes, 1, 4, 3803, Color); + CloseThemeData(hThemes); + end; RText := MakeRect(2, 2, Sender.Width-2, Sender.Height-2); // Create font @@ -335,9 +342,9 @@ var TextWidth, TextHeight : Integer; begin // Checking user owner-draw - if Assigned(Sender.fOnPaint) and (@Sender.fOnPaint <> @WndGroupBoxXPDraw) then + if Assigned(Sender.EV.fOnPaint) and (@Sender.EV.fOnPaint <> @WndGroupBoxXPDraw) then begin - Sender.fOnPaint(Sender, DC); + Sender.EV.fOnPaint(Sender, DC); exit; end; @@ -419,13 +426,23 @@ begin if hThemes <> 0 then begin Sender.Color := Sender.fParent.fColor; - if Sender.fEnabled then fState := 1 else fState := 2; + {$IFDEF USE_FLAGS} + if not (F3_Disabled in Sender.fStyle.f3_Style) then + {$ELSE} + if Sender.fEnabled then + {$ENDIF} + fState := 1 else fState := 2; // Drawing GroupBox rect "step by step" DrawThemeBackground(hThemes, DC, 4{BP_GROUPBOX}, fState{GBS_XXXXXX}, RClient, @RClipMain); DrawThemeBackground(hThemes, DC, 4{BP_GROUPBOX}, fState{GBS_XXXXXX}, RClient, @RClipLeft); DrawThemeBackground(hThemes, DC, 4{BP_GROUPBOX}, fState{GBS_XXXXXX}, RClient, @RClipRight); // Drawing GroupBox text - if not Sender.fEnabled then GetThemeColor(hThemes, {WP_CAPTION} 1, {CS_DISABLED} 3, 3803, Color) + {$IFDEF USE_FLAGS} + if F3_Disabled in Sender.fStyle.f3_Style then + {$ELSE} + if not Sender.fEnabled then + {$ENDIF} + GetThemeColor(hThemes, {WP_CAPTION} 1, {CS_DISABLED} 3, 3803, Color) else GetThemeColor(hThemes, {WP_CAPTION} 1, {CS_ACTIVE} 1, 3803, Color); // Close themes CloseThemeData(hThemes); @@ -460,9 +477,9 @@ var Brush : HBRUSH; begin // Checking user owner-draw - if Assigned(Sender.fOnPaint) and (@Sender.fOnPaint <> @WndCheckBoxXPDraw) then + if Assigned(Sender.EV.fOnPaint) and (@Sender.EV.fOnPaint <> @WndCheckBoxXPDraw) then begin - Sender.fOnPaint(Sender, DC); + Sender.EV.fOnPaint(Sender, DC); exit; end; @@ -475,47 +492,59 @@ begin RClient := Sender.ClientRect; RCheck := RClient; RCheck.Right := RCheck.Left + W; - if Sender.fWordWrap then - RCheck.Top := RCheck.Top + Sender.Border + if {$IFDEF USE_FLAGS} G1_WordWrap in Sender.fFlagsG1 + {$ELSE} Sender.fWordWrap {$ENDIF} then + RCheck.Top := RCheck.Top + Sender.Border else - RCheck.Top := RCheck.Top + (RCheck.Bottom - RCheck.Top - H) div 2; + RCheck.Top := RCheck.Top + (RCheck.Bottom - RCheck.Top - H) div 2; RCheck.Bottom := RCheck.Top + H; RText := MakeRect(RCheck.Right + Sender.Border, RCheck.Top, RClient.Right, RCheck.Bottom); // Getting state fState := 1; {CBS_UNCHECKEDNORMAL} - if not Sender.fEnabled then - fState := 4 {CBS_UNCHECKEDDISABLED} + {$IFDEF USE_FLAGS} + if F3_Disabled in Sender.fStyle.f3_Style then + {$ELSE} + if not Sender.fEnabled then + {$ENDIF} + fState := 4 {CBS_UNCHECKEDDISABLED} else - if Sender.fHot then - fState := 2; {CBS_UNCHECKEDHOT} - if Sender.fPressed then - fState := 3{CBS_UNCHECKEDPRESSED}; + if {$IFDEF USE_FLAGS} G4_Hot in Sender.fFlagsG4 + {$ELSE} Sender.fHot {$ENDIF} then + fState := 2; {CBS_UNCHECKEDHOT} + if {$IFDEF USE_FLAGS} G4_Pressed in Sender.fFlagsG4 + {$ELSE} Sender.fPressed {$ENDIF} then + fState := 3{CBS_UNCHECKEDPRESSED}; case Sender.Check3 of - tsChecked : Inc( fState, 4 ); - tsIndeterminate : Inc( fState, 8 ); + tsChecked : Inc( fState, 4 ); + tsIndeterminate : Inc( fState, 8 ); end; // Draw back layer - if not Sender.fTransparent then - begin - Brush := CreateSolidBrush(Color2RGB(Sender.fParent.Color)); - fDC := SelectObject(DC, Brush); - FillRect(DC, RClient, Brush); - SelectObject(DC, fDC); - DeleteObject(Brush); - end; + if {$IFDEF USE_FLAGS} not( G2_Transparent in Sender.fFlagsG2 ) + {$ELSE} not Sender.fTransparent {$ENDIF} then + begin + Brush := CreateSolidBrush(Color2RGB(Sender.fParent.Color)); + fDC := SelectObject(DC, Brush); + FillRect(DC, RClient, Brush); + SelectObject(DC, fDC); + DeleteObject(Brush); + end; // Draw theme Color := Sender.Font.Color; hThemes := OpenThemeData(Sender.fHandle, 'button'); if hThemes <> 0 then - begin - if not Sender.fEnabled then - GetThemeColor(hThemes, 1, 4, 3803, Color); - DrawThemeBackground(hThemes, DC, 3 {BP_CHECKBOX}, fState, RCheck, @RCheck); - CloseThemeData(hThemes); - end; + begin + {$IFDEF USE_FLAGS} + if F3_Disabled in Sender.fStyle.f3_Style then + {$ELSE} + if not Sender.fEnabled then + {$ENDIF} + GetThemeColor(hThemes, 1, 4, 3803, Color); + DrawThemeBackground(hThemes, DC, 3 {BP_CHECKBOX}, fState, RCheck, @RCheck); + CloseThemeData(hThemes); + end; // Create font F := CreateNewFont(Sender); @@ -548,9 +577,9 @@ var Brush : HBRUSH; begin // Checking user owner-draw - if Assigned(Sender.fOnPaint) and (@Sender.fOnPaint <> @WndRadioBoxXPDraw) then + if Assigned(Sender.EV.fOnPaint) and (@Sender.EV.fOnPaint <> @WndRadioBoxXPDraw) then begin - Sender.fOnPaint(Sender, DC); + Sender.EV.fOnPaint(Sender, DC); exit; end; @@ -563,45 +592,57 @@ begin RClient := Sender.ClientRect; RDot := RClient; RDot.Right := RDot.Left + W; - if Sender.fWordWrap then - RDot.Top := RDot.Top + Sender.Border + if {$IFDEF USE_FLAGS} G1_WordWrap in Sender.fFlagsG1 + {$ELSE} Sender.fWordWrap {$ENDIF} then + RDot.Top := RDot.Top + Sender.Border else - RDot.Top := RDot.Top + (RDot.Bottom - RDot.Top - H) div 2; + RDot.Top := RDot.Top + (RDot.Bottom - RDot.Top - H) div 2; RDot.Bottom := RDot.Top + H; RText := MakeRect(RDot.Right + Sender.Border, RDot.Top, RClient.Right, RDot.Bottom); // Getting state fState := 1; {CBS_UNCHECKEDNORMAL} - if not Sender.fEnabled then - fState := 4 {CBS_UNCHECKEDDISABLED} + {$IFDEF USE_FLAGS} + if F3_Disabled in Sender.fStyle.f3_Style then + {$ELSE} + if not Sender.fEnabled then + {$ENDIF} + fState := 4 {CBS_UNCHECKEDDISABLED} else - if Sender.fHot then - fState := 2; {CBS_UNCHECKEDHOT} - if Sender.fPressed then - fState := 3{CBS_UNCHECKEDPRESSED}; + if {$IFDEF USE_FLAGS} G4_Hot in Sender.fFlagsG4 + {$ELSE} Sender.fHot {$ENDIF} then + fState := 2; {CBS_UNCHECKEDHOT} + if {$IFDEF USE_FLAGS} G4_Pressed in Sender.fFlagsG4 + {$ELSE} Sender.fPressed {$ENDIF} then + fState := 3{CBS_UNCHECKEDPRESSED}; if Sender.Checked then Inc( fState, 4 ); // Draw back layer - if not Sender.fTransparent then - begin - Brush := CreateSolidBrush(Color2RGB(Sender.fParent.Color)); - fDC := SelectObject(DC, Brush); - FillRect(DC, RClient, Brush); - SelectObject(DC, fDC); - DeleteObject(Brush); - end; + if {$IFDEF USE_FLAGS} not( G2_Transparent in Sender.fFlagsG2 ) + {$ELSE} not Sender.fTransparent {$ENDIF} then + begin + Brush := CreateSolidBrush(Color2RGB(Sender.fParent.Color)); + fDC := SelectObject(DC, Brush); + FillRect(DC, RClient, Brush); + SelectObject(DC, fDC); + DeleteObject(Brush); + end; // Draw theme Color := Sender.Font.Color; hThemes := OpenThemeData(Sender.fHandle, 'button'); if hThemes <> 0 then - begin - if not Sender.fEnabled then - GetThemeColor(hThemes, 1, 4, 3803, Color); - DrawThemeBackground(hThemes, DC, 2 {BP_RADIOBOX}, fState, RDot, @RDot); - CloseThemeData(hThemes); - end; + begin + {$IFDEF USE_FLAGS} + if F3_Disabled in Sender.fStyle.f3_Style then + {$ELSE} + if not Sender.fEnabled then + {$ENDIF} + GetThemeColor(hThemes, 1, 4, 3803, Color); + DrawThemeBackground(hThemes, DC, 2 {BP_RADIOBOX}, fState, RDot, @RDot); + CloseThemeData(hThemes); + end; // Create font F := CreateNewFont(Sender); @@ -620,6 +661,7 @@ begin // Draw focusrect if GetFocus = Sender.fHandle then DrawFocusRect(DC, RText); end; + //******************** Drawing Button and BitButton control ******************// procedure WndButtonXPDraw( Dummy : Pointer; Sender: PControl; DC: HDC ); var @@ -646,103 +688,116 @@ var il : PImageList; begin // Checking user owner-draw - if Assigned(Sender.fOnPaint) and (@Sender.fOnPaint <> @WndButtonXPDraw) then - begin - Sender.fOnPaint(Sender, DC); - exit; - end; - if Assigned(Sender.fOnBitBtnDraw) then - begin + if Assigned(Sender.EV.fOnPaint) + and (TMethod(Sender.EV.fOnPaint).Code <> @WndButtonXPDraw) then + begin + Sender.EV.fOnPaint(Sender, DC); + exit; + end; + if Assigned(Sender.EV.fOnBitBtnDraw) + and (TMethod(Sender.EV.fOnBitBtnDraw).Code <> @DummyProc123_0) then + begin fState := 0{PBS_NORMAL}; - if not Sender.fEnabled then - fState := 2{PBS_DISABLED} - else - if GetFocus = Sender.fHandle then - fState := 3{PBS_PRESSED} - else - if Sender.fHot then - fState := 4{PBS_HOT}; - if Sender.fPressed then - fState := 1{PBS_PRESSED}; - Sender.fOnBitBtnDraw(Sender, fState); + {$IFDEF USE_FLAGS} + if F3_Disabled in Sender.fStyle.f3_Style then + {$ELSE} + if not Sender.fEnabled then + {$ENDIF} + fState := 2{PBS_DISABLED} + else + if GetFocus = Sender.fHandle then + fState := 3{PBS_PRESSED} + else + if {$IFDEF USE_FLAGS} G4_Hot in Sender.fFlagsG4 + {$ELSE} Sender.fHot {$ENDIF} then + fState := 4{PBS_HOT}; + if {$IFDEF USE_FLAGS} G4_Pressed in Sender.fFlagsG4 + {$ELSE} Sender.fPressed {$ENDIF} then + fState := 1{PBS_PRESSED}; + Sender.EV.fOnBitBtnDraw(Sender, fState); exit; - end; + end; // Getting rects RClient := Sender.ClientRect; RText := RClient; // Calc bitmap rect - Bmp := Sender.fGlyphBitmap; + Bmp := Sender.DF.fGlyphBitmap; HPos := 0; VPos := 0; - if Bmp <> 0 then - begin - SenderWidth := Sender.Width; - SenderHeight := Sender.Height; - W := Sender.fGlyphWidth; - H := Sender.fGlyphHeight; - if Sender.fglyphLayout in [ glyphLeft ] then - begin - RIcon := MakeRect((SenderWidth div 2) - (W + (W div 4)), - (SenderHeight div 2) - (H div 2), - W, SenderHeight); - RText.Left := (SenderWidth div 2) + (W div 4); - HPos := DT_LEFT; - VPos := DT_VCENTER; - end; - if Sender.fglyphLayout in [ glyphRight ] then - begin - RIcon := MakeRect((SenderWidth div 2) + (W div 4), - (SenderHeight div 2) - (H div 2), - W, SenderHeight); - RText.Right := (SenderWidth div 2) - (W div 4); - HPos := DT_RIGHT; - VPos := DT_VCENTER; - end; - if Sender.fglyphLayout in [ glyphOver ] then - begin - RIcon := MakeRect((SenderWidth div 2) - (W div 2), - (SenderHeight div 2) - (H div 2), - W, SenderHeight); - HPos := DT_CENTER; - VPos := DT_VCENTER; - end; - if Sender.fglyphLayout in [ glyphTop ] then - begin - RIcon := MakeRect((SenderWidth div 2) - (W div 2), - (SenderHeight div 2) - (H + (H div 4)), - W, SenderHeight); - RText.Top := (SenderHeight div 2) + (H div 4); - HPos := DT_CENTER; - VPos := DT_TOP; - end; - if Sender.fglyphLayout in [ glyphBottom ] then - begin - RIcon := MakeRect((SenderWidth div 2) - (W div 2), - (SenderHeight div 2) + (H div 4), - W, SenderHeight); - RText.Bottom := (SenderHeight div 2) - (H div 4); - HPos := DT_CENTER; - VPos := DT_BOTTOM; - end; - end - else - begin + if Bmp <> 0 then + begin + SenderWidth := Sender.Width; + SenderHeight := Sender.Height; + W := Sender.DF.fGlyphWidth; + H := Sender.DF.fGlyphHeight; + if Sender.DF.fGlyphLayout in [ glyphLeft ] then + begin + RIcon := MakeRect((SenderWidth div 2) - (W + (W div 4)), + (SenderHeight div 2) - (H div 2), + W, SenderHeight); + RText.Left := (SenderWidth div 2) + (W div 4); + HPos := DT_LEFT; + VPos := DT_VCENTER; + end; + if Sender.DF.fGlyphLayout in [ glyphRight ] then + begin + RIcon := MakeRect((SenderWidth div 2) + (W div 4), + (SenderHeight div 2) - (H div 2), + W, SenderHeight); + RText.Right := (SenderWidth div 2) - (W div 4); + HPos := DT_RIGHT; + VPos := DT_VCENTER; + end; + if Sender.DF.fGlyphLayout in [ glyphOver ] then + begin + RIcon := MakeRect((SenderWidth div 2) - (W div 2), + (SenderHeight div 2) - (H div 2), + W, SenderHeight); + HPos := DT_CENTER; + VPos := DT_VCENTER; + end; + if Sender.DF.fGlyphLayout in [ glyphTop ] then + begin + RIcon := MakeRect((SenderWidth div 2) - (W div 2), + (SenderHeight div 2) - (H + (H div 4)), + W, SenderHeight); + RText.Top := (SenderHeight div 2) + (H div 4); + HPos := DT_CENTER; + VPos := DT_TOP; + end; + if Sender.DF.fGlyphLayout in [ glyphBottom ] then + begin + RIcon := MakeRect((SenderWidth div 2) - (W div 2), + (SenderHeight div 2) + (H div 4), + W, SenderHeight); + RText.Bottom := (SenderHeight div 2) - (H div 4); + HPos := DT_CENTER; + VPos := DT_BOTTOM; + end; + end else + begin HPos := DT_CENTER; VPos := DT_VCENTER; RIcon := MakeRect(0, 0, 0, 0); - end; + end; // Getting caption S := Sender.fCaption; // Getting state fState := 1{PBS_NORMAL}; - if not Sender.fEnabled then - fState := 4{PBS_DISABLED} - else - if Sender.fHot then - fState := 2{PBS_HOT}; - if Sender.fPressed then - fState := 3{PBS_PRESSED}; + {$IFDEF USE_FLAGS} + if F3_Disabled in Sender.fStyle.f3_Style then + {$ELSE} + if not Sender.fEnabled then + {$ENDIF} + fState := 4{PBS_DISABLED} + else + if {$IFDEF USE_FLAGS} G4_Hot in Sender.fFlagsG4 + {$ELSE} Sender.fHot {$ENDIF} then + fState := 2{PBS_HOT}; + if {$IFDEF USE_FLAGS} G4_Pressed in Sender.fFlagsG4 + {$ELSE} Sender.fPressed {$ENDIF} then + fState := 3{PBS_PRESSED}; // Opening themes hThemes := OpenThemeData(Sender.fHandle, 'button'); if hThemes <> 0 then @@ -765,14 +820,19 @@ begin if Bmp <> 0 then begin - if bboImageList in Sender.fBitBtnOptions then + if bboImageList in Sender.DF.fBitBtnOptions then begin bStyle := ILD_TRANSPARENT; - if Sender.fEnabled then i := Sender.BitBtnImgIdx + {$IFDEF USE_FLAGS} + if not (F3_Disabled in Sender.fStyle.f3_Style) then + {$ELSE} + if Sender.fEnabled then + {$ENDIF} + i := Sender.BitBtnImgIdx else begin ic := NewIcon; - ic.fSize := Sender.fGlyphWidth; + ic.fSize := Sender.DF.fGlyphWidth; ic.fHandle := ImageList_GetIcon(Bmp, Sender.BitBtnImgIdx, bStyle); b := NewBitmap(ic.fSize, ic.fSize); b.fHandle := ic.Convert2Bitmap(clBtnFace); @@ -786,7 +846,12 @@ begin else begin _DC := CreateCompatibleDC( 0 ); - if Sender.fEnabled then OldBmp := SelectObject( _DC, Bmp) + {$IFDEF USE_FLAGS} + if not (F3_Disabled in Sender.fStyle.f3_Style) then + {$ELSE} + if Sender.fEnabled then + {$ENDIF} + OldBmp := SelectObject( _DC, Bmp) else begin bStyle := ILD_TRANSPARENT; @@ -794,7 +859,7 @@ begin il.HandleNeeded; i := ImageList_Add(il.fHandle, Bmp, 0); ic := NewIcon; - ic.fSize := Sender.fGlyphWidth; + ic.fSize := Sender.DF.fGlyphWidth; ic.fHandle := ImageList_GetIcon(il.fHandle, i, bStyle); b := NewBitmap(ic.fSize, ic.fSize); b.fHandle := ic.Convert2Bitmap(clBtnFace); @@ -804,8 +869,8 @@ begin Free_And_Nil(ic); Free_And_Nil(il); end; - StretchBlt( DC, RIcon.Left, RIcon.Top, Sender.fGlyphWidth, Sender.fGlyphHeight, - _DC, 0, 0, Sender.fGlyphWidth, Sender.fGlyphHeight, + StretchBlt( DC, RIcon.Left, RIcon.Top, Sender.DF.fGlyphWidth, Sender.DF.fGlyphHeight, + _DC, 0, 0, Sender.DF.fGlyphWidth, Sender.DF.fGlyphHeight, SRCCOPY); SelectObject( _DC, OldBmp ); DeleteDC( _DC ); @@ -841,25 +906,87 @@ begin CloseThemeData(hThemes); end; - if (GetFocus = Sender.fHandle) and (bboFocusRect in Sender.fBitBtnOptions) then + if (GetFocus = Sender.fHandle) and (bboFocusRect in Sender.DF.fBitBtnOptions) then DrawFocusRect(DC, MakeRect(RClient.Left+4, RClient.Top+4, RClient.Right-4, RClient.Bottom-4)); end; //************************* Control MouseEnter event *************************// +{$IFDEF ASM_VERSION} +procedure WndXPMouseEnter( Dummy : Pointer; Sender: PObj ); +asm + {$IFDEF USE_FLAGS} + OR [EDX].TControl.fFlagsG4, 1 shl G4_Hot + {$ELSE} + MOV [EDX].TControl.fHot, 1 + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EDX].TControl.EV + MOV ECX, [EAX].TEvents.fOnMouseEnter.TMethod.Code + {$ELSE} + MOV ECX, [EDX].TControl.EV.fOnMouseEnter.TMethod.Code + {$ENDIF} + JECXZ @@fin + CMP ECX, offset[WndXPMouseEnter] + JZ @@fin + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TEvents.fOnMouseEnter.TMethod.Data + {$ELSE} + MOV EAX, [EDX].TControl.EV.fOnMouseEnter.TMethod.Data + {$ENDIF} + CALL ECX +@@fin: +end; +{$ELSE} procedure WndXPMouseEnter( Dummy : Pointer; Sender: PObj ); begin - PControl(Sender).fHot := true; - if Assigned(PControl(Sender).fOnMouseEnter) and - (@PControl(Sender).fOnMouseEnter <> @WndXPMouseEnter) then - PControl(Sender).fOnMouseEnter(Sender); + with PControl(Sender)^ do + begin + {$IFDEF USE_FLAGS} + fFlagsG4 := fFlagsG4 + [G4_Hot]; + {$ELSE} fHot := true; {$ENDIF} + if Assigned(EV.fOnMouseEnter) and + (@EV.fOnMouseEnter <> @WndXPMouseEnter) then + EV.fOnMouseEnter(Sender); + end; end; +{$ENDIF} //************************* Control MouseLeave event *************************// +{$IFDEF ASM_VERSION} +procedure WndXPMouseLeave( Dummy : Pointer; Sender: PObj ); +asm + {$IFDEF USE_FLAGS} + AND [EDX].TControl.fFlagsG4, not(1 shl G4_Hot) + {$ELSE} + MOV [EDX].TControl.fHot, 0 + {$ENDIF} + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EDX].TControl.EV + MOV ECX, [EAX].TEvents.fOnMouseLeave.TMethod.Code + {$ELSE} + MOV ECX, [EDX].TControl.EV.fOnMouseLeave.TMethod.Code + {$ENDIF} + JECXZ @@fin + CMP ECX, offset[WndXPMouseLeave] + JZ @@fin + {$IFDEF EVENTS_DYNAMIC} + MOV EAX, [EAX].TEvents.fOnMouseLeave.TMethod.Data + {$ELSE} + MOV EAX, [EDX].TControl.EV.fOnMouseLeave.TMethod.Data + {$ENDIF} + CALL ECX +@@fin: +end; +{$ELSE} procedure WndXPMouseLeave( Dummy : Pointer; Sender: PObj ); begin - PControl(Sender).fHot := false; - if Assigned(PControl(Sender).fOnMouseLeave) and - (@PControl(Sender).fOnMouseLeave <> @WndXPMouseLeave) then - PControl(Sender).fOnMouseLeave(Sender); + {$IFDEF USE_FLAGS} + PControl(Sender).fFlagsG4 := + PControl(Sender).fFlagsG4 - [G4_Hot]; + {$ELSE} PControl(Sender).fHot := false; {$ENDIF} + if Assigned(PControl(Sender).EV.fOnMouseLeave) and + (@PControl(Sender).EV.fOnMouseLeave <> @WndXPMouseLeave) then + PControl(Sender).EV.fOnMouseLeave(Sender); end; +{$ENDIF} //*************************** Control Message event **************************// function WndXPMessage( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; var @@ -872,7 +999,7 @@ begin case Msg.message of WM_LBUTTONDBLCLK: begin - if Assigned(Sender.fOnMouseDblClk) then + if Assigned(Sender.EV.fOnMouseDblClk) then begin Mouse.Button := mbLeft; Mouse.StopHandling := false; @@ -887,124 +1014,131 @@ begin Mouse.X := pt.X; Mouse.Y := pt.Y; end; - Sender.fOnMouseDblClk(Sender, Mouse); + Sender.EV.fOnMouseDblClk(Sender, Mouse); end; - if not Sender.fIsSplitter then - SendMessage( Sender.fHandle, WM_LBUTTONDOWN, Msg.wParam, Msg.lParam ); + if {$IFDEF USE_FLAGS} not(G5_IsSplitter in Sender.fFlagsG5) + {$ELSE} not Sender.fIsSplitter {$ENDIF} then + Sender.Perform( WM_LBUTTONDOWN, Msg.wParam, Msg.lParam ); end; WM_LBUTTONDOWN: begin - if Assigned(Sender.fOnMouseDown) then - begin - Mouse.Button := mbLeft; - Mouse.StopHandling := false; - Mouse.R1 := 0; - Mouse.R2 := 0; - Mouse.Shift := 120; - Mouse.X := 0; - Mouse.Y := 0; - GetCursorPos(pt); - if ScreenToClient(Sender.fHandle, pt) then - begin - Mouse.X := pt.X; - Mouse.Y := pt.Y; - end; - Sender.fOnMouseDown(Sender, Mouse); - end; - Sender.fPressed := true; + if Assigned(Sender.EV.fOnMouseDown) then + begin + Mouse.Button := mbLeft; + Mouse.StopHandling := false; + Mouse.R1 := 0; + Mouse.R2 := 0; + Mouse.Shift := 120; + Mouse.X := 0; + Mouse.Y := 0; + GetCursorPos(pt); + if ScreenToClient(Sender.fHandle, pt) then + begin + Mouse.X := pt.X; + Mouse.Y := pt.Y; + end; + Sender.EV.fOnMouseDown(Sender, Mouse); + end; + {$IFDEF USE_FLAGS} Sender.fFlagsG4 := Sender.fFlagsG4 + [G4_Pressed]; + {$ELSE} Sender.fPressed := true; {$ENDIF} dDC := GetWindowDC(Msg.hWnd); - Sender.OnPaint(Sender, dDC); - ReleaseDC( Msg.hWnd, dDC ); + Sender.EV.fOnPaint(Sender, dDC); + ReleaseDC( Msg.hWnd, dDC ); // vampir_infernal 15.10.2008 end; WM_LBUTTONUP: begin - if Assigned(Sender.fOnMouseUp) then - begin - Mouse.Button := mbLeft; - Mouse.StopHandling := false; - Mouse.R1 := 0; - Mouse.R2 := 0; - Mouse.Shift := 120; - Mouse.X := 0; - Mouse.Y := 0; - GetCursorPos(pt); - if ScreenToClient(Sender.fHandle, pt) then - begin - Mouse.X := pt.X; - Mouse.Y := pt.Y; - end; - Sender.fOnMouseUp(Sender, Mouse); - end; - Sender.fPressed := false; + if Assigned(Sender.EV.fOnMouseUp) then + begin + Mouse.Button := mbLeft; + Mouse.StopHandling := false; + Mouse.R1 := 0; + Mouse.R2 := 0; + Mouse.Shift := 120; + Mouse.X := 0; + Mouse.Y := 0; + GetCursorPos(pt); + if ScreenToClient(Sender.fHandle, pt) then + begin + Mouse.X := pt.X; + Mouse.Y := pt.Y; + end; + Sender.EV.fOnMouseUp(Sender, Mouse); + end; + {$IFDEF USE_FLAGS} Sender.fFlagsG4 := Sender.fFlagsG4 - [G4_Pressed]; + {$ELSE} Sender.fPressed := false; {$ENDIF} dDC := GetWindowDC(Msg.hWnd); - Sender.OnPaint(Sender, dDC); + Sender.EV.fOnPaint(Sender, dDC); ReleaseDC( Msg.hWnd, dDC ); end; WM_KEYDOWN: begin - if Msg.wParam = VK_SPACE then - begin - if Assigned(Sender.fOnKeyDown) then - Sender.fOnKeyDown(Sender, Msg.wParam, GetShiftState); - Sender.fPressed := true; - dDC := GetWindowDC(Msg.hWnd); - Sender.OnPaint(Sender, dDC); - ReleaseDC( Msg.hWnd, dDC ); - end; + if Msg.wParam = VK_SPACE then + begin + if Assigned(Sender.EV.fOnKeyDown) then + Sender.EV.fOnKeyDown(Sender, Msg.wParam, GetShiftState); + {$IFDEF USE_FLAGS} Sender.fFlagsG4 := Sender.fFlagsG4 + [G4_Pressed]; + {$ELSE} Sender.fPressed := true; {$ENDIF} + dDC := GetWindowDC(Msg.hWnd); + Sender.EV.fOnPaint(Sender, dDC); + ReleaseDC( Msg.hWnd, dDC ); + end; end; WM_KEYUP: begin - if Msg.wParam = VK_SPACE then - begin - if Assigned(Sender.fOnKeyUp) then - Sender.fOnKeyUp(Sender, Msg.wParam, GetShiftState); - Sender.fPressed := false; - dDC := GetWindowDC(Msg.hWnd); - Sender.OnPaint(Sender, dDC); - ReleaseDC( Msg.hWnd, dDC ); - end; + if Msg.wParam = VK_SPACE then + begin + if Assigned(Sender.EV.fOnKeyUp) then + Sender.EV.fOnKeyUp(Sender, Msg.wParam, GetShiftState); + {$IFDEF USE_FLAGS} Sender.fFlagsG4 := Sender.fFlagsG4 - [G4_Pressed]; + {$ELSE} Sender.fPressed := false; {$ENDIF} + dDC := GetWindowDC(Msg.hWnd); + Sender.EV.fOnPaint(Sender, dDC); + ReleaseDC( Msg.hWnd, dDC ); + end; end; WM_KILLFOCUS: begin - Sender.fHot := false; - dDC := GetWindowDC(Msg.hWnd); - Sender.OnPaint(Sender, dDC); - ReleaseDC( Msg.hWnd, dDC ); + {$IFDEF USE_FLAGS} Sender.fFlagsG4 := Sender.fFlagsG4 - [G4_Hot]; + {$ELSE} Sender.fHot := false; {$ENDIF} + dDC := GetWindowDC(Msg.hWnd); + Sender.EV.fOnPaint(Sender, dDC); + ReleaseDC( Msg.hWnd, dDC ); end; WM_SETFOCUS: begin - Sender.fHot := true; - dDC := GetWindowDC(Msg.hWnd); - Sender.OnPaint(Sender, dDC); - ReleaseDC( Msg.hWnd, dDC ); - Result := true; + {$IFDEF USE_FLAGS} Sender.fFlagsG4 := Sender.fFlagsG4 + [G4_Hot]; + {$ELSE} Sender.fHot := TRUE; {$ENDIF} + dDC := GetWindowDC(Msg.hWnd); + Sender.EV.fOnPaint(Sender, dDC); + ReleaseDC( Msg.hWnd, dDC ); + Result := true; end; end; end; //*************************** Events for CheckBox ****************************// procedure XP_Themes_For_CheckBox(Sender : PControl); begin - if AppTheming then - Sender.OnPaint := TOnPaint( MakeMethod( nil, @WndCheckBoxXPDraw ) ); + if AppTheming then + Sender.OnPaint := TOnPaint( MakeMethod( nil, @WndCheckBoxXPDraw ) ); end; //*************************** Events for RadioBox ****************************// procedure XP_Themes_For_RadioBox(Sender : PControl); begin - if AppTheming then - Sender.OnPaint := TOnPaint( MakeMethod( nil, @WndRadioBoxXPDraw ) ); + if AppTheming then + Sender.OnPaint := TOnPaint( MakeMethod( nil, @WndRadioBoxXPDraw ) ); end; //**************************** Events for Panel ******************************// procedure XP_Themes_For_Panel(Sender : PControl); begin if AppTheming then begin - if Sender.fedgeStyle = esTransparent then Sender.SetTransparent(True) else + if Sender.EdgeStyle = esTransparent then Sender.SetTransparent(True) else begin Sender.OnResize := TOnEvent( MakeMethod( nil, @WndPanelXPResize ) ); Sender.OnPaint := TOnPaint( MakeMethod( nil, @WndPanelXPDraw ) ); @@ -1028,14 +1162,14 @@ end; //************************** Events for GroupBox *****************************// procedure XP_Themes_For_GroupBox(Sender : PControl); begin - if AppTheming then - Sender.OnPaint := TOnPaint( MakeMethod( nil, @WndGroupBoxXPDraw ) ); + if AppTheming then + Sender.OnPaint := TOnPaint( MakeMethod( nil, @WndGroupBoxXPDraw ) ); end; //************************** Events for TabPanel *****************************// procedure XP_Themes_For_TabPanel(Sender : PControl); begin - if AppTheming then - Sender.OnPaint := TOnPaint( MakeMethod( nil, @WndTabXPDraw ) ); + if AppTheming then + Sender.OnPaint := TOnPaint( MakeMethod( nil, @WndTabXPDraw ) ); end; //********************* Events for Button and BitButton **********************// procedure XP_Themes_For_BitBtn(Sender : PControl); @@ -1051,14 +1185,27 @@ end; //*********************** Deattach ownerdraw function ************************// procedure Deattach(Sender : PControl; PaintProc : Pointer); begin - if Sender.IsProcAttached(WndXPMessage) then - Sender.DetachProc(WndXPMessage); - if Assigned(Sender.fOnMouseEnter) and (@Sender.fOnMouseEnter = @WndXPMouseEnter) and (not Sender.fFlat) then - Sender.fOnMouseEnter := nil; - if Assigned(Sender.fOnMouseLeave) and (@Sender.fOnMouseLeave = @WndXPMouseLeave) and (not Sender.fFlat) then - Sender.fOnMouseLeave := nil; - if Assigned(Sender.fOnPaint) and (@Sender.fOnPaint = PaintProc) then - Sender.fOnPaint := nil; + if Sender.IsProcAttached(WndXPMessage) then + Sender.DetachProc(WndXPMessage); + if {$IFDEF NIL_EVENTS} Assigned(Sender.EV.fOnMouseEnter) and {$ENDIF} + (@Sender.EV.fOnMouseEnter = @WndXPMouseEnter) + and ({$IFDEF USE_FLAGS} not(G3_Flat in Sender.fFlagsG3) + {$ELSE} not Sender.fFlat {$ENDIF}) then + {$IFDEF NIL_EVENTS} Sender.EV.fOnMouseEnter := nil; + {$ELSE} TMethod( Sender.EV.fOnMouseEnter ).Code := @DummyObjProc; + {$ENDIF} + if {$IFDEF NIL_EVENTS} Assigned(Sender.EV.fOnMouseLeave) and {$ENDIF} + (@Sender.EV.fOnMouseLeave = @WndXPMouseLeave) + and ({$IFDEF USE_FLAGS} not(G3_Flat in Sender.fFlagsG3) + {$ELSE} not Sender.fFlat {$ENDIF}) then + {$IFDEF NIL_EVENTS} Sender.EV.fOnMouseLeave := nil; + {$ELSE} TMethod( Sender.EV.fOnMouseLeave ).Code := @DummyObjProc; + {$ENDIF} + if {$IFDEF NIL_EVENTS} Assigned(Sender.EV.fOnPaint) and {$ENDIF} + (@Sender.EV.fOnPaint = PaintProc) then + {$IFDEF NIL_EVENTS} Sender.EV.fOnPaint := nil; + {$ELSE} TMethod( Sender.EV.fOnPaint ).Code := @DummyObjProc; + {$ENDIF} end; //********************* Handling of message WM_THEMECHANGED ******************// function WndXP_WM_THEMECHANGED( Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean; @@ -1066,159 +1213,228 @@ begin Result := false; if Msg.message = $31A {WM_THEMECHANGED} then - begin + begin if AppTheming then DeinitThemes; CheckThemes; if AppTheming then - begin - InitThemes; - if ((Sender.fStyle and BS_AUTOCHECKBOX) = BS_AUTOCHECKBOX) and - (Sender.SubClassName = 'obj_BUTTON') and - (Sender.fIsGroupBox = false) and - (Sender.fIsSplitter = false) and - (Sender.fIsBitBtn = false) then - begin - XP_Themes_For_CheckBox(Sender); - exit; - end; - if ((Sender.fStyle and BS_AUTO3STATE) = BS_AUTO3STATE) and - (Sender.SubClassName = 'obj_BUTTON') and - (Sender.fIsGroupBox = false) and - (Sender.fIsSplitter = false) and - (Sender.fIsBitBtn = false) then - begin - XP_Themes_For_CheckBox(Sender); - exit; - end; - if ((Sender.fStyle and BS_RADIOBUTTON) = BS_RADIOBUTTON) and - (Sender.SubClassName = 'obj_BUTTON') and - (Sender.fIsGroupBox = false) and - (Sender.fIsSplitter = false) and - (Sender.fIsBitBtn = false) then - begin - XP_Themes_For_RadioBox(Sender); - exit; - end; - if ((Sender.fStyle and BS_GROUPBOX) = BS_GROUPBOX) and - (Sender.SubClassName = 'obj_BUTTON') and - (Sender.fIsGroupBox = true) and - (Sender.fIsSplitter = false) and - (Sender.fIsBitBtn = false) then - begin - XP_Themes_For_GroupBox(Sender); - exit; - end; - if (Sender.SubClassName = 'obj_BUTTON') and - (Sender.fIsGroupBox = false) and - (Sender.fIsSplitter = false) then - begin - XP_Themes_For_BitBtn(Sender); - exit; - end; - if (Sender.SubClassName = 'obj_STATIC') then - begin - if Sender.fIsStaticControl > 0 then XP_Themes_For_Label(Sender) - else - begin - if Sender.fIsSplitter then XP_Themes_For_Splitter(Sender) - else - begin - if Sender.fParent.SubClassName = 'obj_SysTabControl32' then - XP_Themes_For_TabPanel(Sender) - else - XP_Themes_For_Panel(Sender); - end; - end; - exit; - end; - end - else - begin - if ((Sender.fStyle and BS_AUTOCHECKBOX) = BS_AUTOCHECKBOX) and + begin + InitThemes; + if ((Sender.fStyle.Value and BS_AUTOCHECKBOX) = BS_AUTOCHECKBOX) and (Sender.SubClassName = 'obj_BUTTON') and + {$IFDEF USE_FLAGS} + ([G5_IsGroupbox, G5_IsSplitter, G5_IsBitBtn] * Sender.fFlagsG5 = []) + {$ELSE} (Sender.fIsGroupBox = false) and (Sender.fIsSplitter = false) and - (Sender.fIsBitBtn = false) then - begin - Deattach(Sender, @WndCheckBoxXPDraw); - exit; - end; - if ((Sender.fStyle and BS_AUTO3STATE) = BS_AUTO3STATE) and + (Sender.fIsBitBtn = false) {$ENDIF} then + begin + XP_Themes_For_CheckBox(Sender); + exit; + end; + if ((Sender.fStyle.Value and BS_AUTO3STATE) = BS_AUTO3STATE) and (Sender.SubClassName = 'obj_BUTTON') and + {$IFDEF USE_FLAGS} + ([G5_IsGroupbox, G5_IsSplitter, G5_IsBitBtn] * Sender.fFlagsG5 = []) + {$ELSE} (Sender.fIsGroupBox = false) and (Sender.fIsSplitter = false) and - (Sender.fIsBitBtn = false) then - begin - Deattach(Sender, @WndCheckBoxXPDraw); - exit; - end; - if ((Sender.fStyle and BS_RADIOBUTTON) = BS_RADIOBUTTON) and + (Sender.fIsBitBtn = false) {$ENDIF} then + begin + XP_Themes_For_CheckBox(Sender); + exit; + end; + if ((Sender.fStyle.Value and BS_RADIOBUTTON) = BS_RADIOBUTTON) and (Sender.SubClassName = 'obj_BUTTON') and + {$IFDEF USE_FLAGS} + ([G5_IsGroupbox, G5_IsSplitter, G5_IsBitBtn] * Sender.fFlagsG5 = []) + {$ELSE} (Sender.fIsGroupBox = false) and (Sender.fIsSplitter = false) and - (Sender.fIsBitBtn = false) then - begin - Deattach(Sender, @WndRadioBoxXPDraw); - exit; - end; - if ((Sender.fStyle and BS_GROUPBOX) = BS_GROUPBOX) and + (Sender.fIsBitBtn = false) {$ENDIF} then + begin + XP_Themes_For_RadioBox(Sender); + exit; + end; + if ((Sender.fStyle.Value and BS_GROUPBOX) = BS_GROUPBOX) and (Sender.SubClassName = 'obj_BUTTON') and + {$IFDEF USE_FLAGS} + ([G5_IsGroupbox, G5_IsSplitter, G5_IsBitBtn] * Sender.fFlagsG5 = + [G5_IsGroupbox]) + {$ELSE} (Sender.fIsGroupBox = true) and (Sender.fIsSplitter = false) and - (Sender.fIsBitBtn = false) then - begin - Deattach(Sender, @WndGroupBoxXPDraw); - exit; - end; + (Sender.fIsBitBtn = false) {$ENDIF} then + begin + XP_Themes_For_GroupBox(Sender); + exit; + end; if (Sender.SubClassName = 'obj_BUTTON') and + {$IFDEF USE_FLAGS} + ([G5_IsGroupbox, G5_IsSplitter] * Sender.fFlagsG5 = []) + {$ELSE} (Sender.fIsGroupBox = false) and - (Sender.fIsSplitter = false) then - begin - Deattach(Sender, @WndButtonXPDraw); - exit; - end; + (Sender.fIsSplitter = false) {$ENDIF} then + begin + XP_Themes_For_BitBtn(Sender); + exit; + end; if (Sender.SubClassName = 'obj_STATIC') then - begin - if Sender.fIsStaticControl > 0 then - else + begin + if {$IFDEF USE_FLAGS} G1_IsStaticControl in Sender.fFlagsG1 + {$ELSE} Sender.fIsStaticControl > 0 {$ENDIF} then + XP_Themes_For_Label(Sender) + else + begin + if {$IFDEF USE_FLAGS} G5_IsSplitter in Sender.fFlagsG5 + {$ELSE} Sender.fIsSplitter {$ENDIF} then + XP_Themes_For_Splitter(Sender) + else begin - if Sender.fIsSplitter then Deattach(Sender, @WndSplitterXPDraw) - else - if Sender.fParent.SubClassName = 'obj_SysTabControl32' then - Deattach(Sender, @WndTabXPDraw) - else - begin - Deattach(Sender, @WndPanelXPDraw); - case Sender.fedgeStyle of - esRaised: - begin - Sender.fStyle := Sender.fStyle and (not SS_SUNKEN); - Sender.fExStyle := Sender.fExStyle and (not WS_EX_STATICEDGE); - Sender.fExStyle := Sender.fExStyle or WS_EX_WINDOWEDGE; - Sender.fStyle := Sender.fStyle or WS_DLGFRAME; - end; - esLowered: - begin - Sender.fStyle := Sender.fStyle and (not WS_DLGFRAME); - Sender.fExStyle := Sender.fExStyle or WS_EX_WINDOWEDGE; - Sender.fExStyle := Sender.fExStyle or WS_EX_STATICEDGE; - Sender.fStyle := Sender.fStyle or SS_SUNKEN; - end; - else - Sender.fStyle := Sender.fStyle and (not SS_SUNKEN) and (not WS_DLGFRAME); - Sender.fExStyle := Sender.fExStyle and (not WS_EX_STATICEDGE) or WS_EX_WINDOWEDGE; - end; - end; - end; - Sender.SetTransparent(Sender.fClassicTransparent); + if Sender.fParent.SubClassName = 'obj_SysTabControl32' then + XP_Themes_For_TabPanel(Sender) + else + XP_Themes_For_Panel(Sender); + end; + end; exit; - end; - end; - end; + end; + end else + begin + if ((Sender.fStyle.Value and BS_AUTOCHECKBOX) = BS_AUTOCHECKBOX) and + (Sender.SubClassName = 'obj_BUTTON') and + {$IFDEF USE_FLAGS} + ([G5_IsGroupbox, G5_IsSplitter, G5_IsBitBtn] * Sender.fFlagsG5 = []) + {$ELSE} + (Sender.fIsGroupBox = false) and + (Sender.fIsSplitter = false) and + (Sender.fIsBitBtn = false) {$ENDIF} then + begin + Deattach(Sender, @WndCheckBoxXPDraw); + exit; + end; + if ((Sender.fStyle.Value and BS_AUTO3STATE) = BS_AUTO3STATE) and + (Sender.SubClassName = 'obj_BUTTON') and + {$IFDEF USE_FLAGS} + ([G5_IsGroupbox, G5_IsSplitter, G5_IsBitBtn] * Sender.fFlagsG5 = []) + {$ELSE} + (Sender.fIsGroupBox = false) and + (Sender.fIsSplitter = false) and + (Sender.fIsBitBtn = false) {$ENDIF} then + begin + Deattach(Sender, @WndCheckBoxXPDraw); + exit; + end; + if ((Sender.fStyle.Value and BS_RADIOBUTTON) = BS_RADIOBUTTON) and + (Sender.SubClassName = 'obj_BUTTON') and + {$IFDEF USE_FLAGS} + ([G5_IsGroupbox, G5_IsSplitter, G5_IsBitBtn] * Sender.fFlagsG5 = []) + {$ELSE} + (Sender.fIsGroupBox = false) and + (Sender.fIsSplitter = false) and + (Sender.fIsBitBtn = false) {$ENDIF} then + begin + Deattach(Sender, @WndRadioBoxXPDraw); + exit; + end; + if ((Sender.fStyle.Value and BS_GROUPBOX) = BS_GROUPBOX) and + (Sender.SubClassName = 'obj_BUTTON') and + {$IFDEF USE_FLAGS} + ([G5_IsGroupbox, G5_IsSplitter, G5_IsBitBtn] * Sender.fFlagsG5 = + [G5_IsGroupbox]) + {$ELSE} + (Sender.fIsGroupBox = true) and + (Sender.fIsSplitter = false) and + (Sender.fIsBitBtn = false) {$ENDIF} then + begin + Deattach(Sender, @WndGroupBoxXPDraw); + exit; + end; + if (Sender.SubClassName = 'obj_BUTTON') and + {$IFDEF USE_FLAGS} + ([G5_IsGroupbox, G5_IsSplitter] * Sender.fFlagsG5 = []) + {$ELSE} + (Sender.fIsGroupBox = false) and + (Sender.fIsSplitter = false) {$ENDIF} then + begin + Deattach(Sender, @WndButtonXPDraw); + exit; + end; + if (Sender.SubClassName = 'obj_STATIC') then + begin + if {$IFDEF USE_FLAGS} G1_IsStaticControl in Sender.fFlagsG1 + {$ELSE} Sender.fIsStaticControl > 0 {$ENDIF} then + else + begin + if {$IFDEF USE_FLAGS} G5_IsSplitter in Sender.fFlagsG5 + {$ELSE} Sender.fIsSplitter {$ENDIF} then + Deattach(Sender, @WndSplitterXPDraw) + else if Sender.fParent.SubClassName = 'obj_SysTabControl32' then + Deattach(Sender, @WndTabXPDraw) + else + begin + Deattach(Sender, @WndPanelXPDraw); + case Sender.EdgeStyle of + esRaised: + begin + Sender.fStyle.Value := Sender.fStyle.Value and (not SS_SUNKEN); + Sender.fExStyle := Sender.fExStyle and (not WS_EX_STATICEDGE); + Sender.fExStyle := Sender.fExStyle or WS_EX_WINDOWEDGE; + Sender.fStyle.Value := Sender.fStyle.Value or WS_DLGFRAME; + end; + esLowered: + begin + Sender.fStyle.Value := Sender.fStyle.Value and (not WS_DLGFRAME); + Sender.fExStyle := Sender.fExStyle or WS_EX_WINDOWEDGE; + Sender.fExStyle := Sender.fExStyle or WS_EX_STATICEDGE; + Sender.fStyle.Value := Sender.fStyle.Value or SS_SUNKEN; + end; + else + Sender.fStyle.Value := Sender.fStyle.Value and (not SS_SUNKEN) and (not WS_DLGFRAME); + Sender.fExStyle := Sender.fExStyle and (not WS_EX_STATICEDGE) or WS_EX_WINDOWEDGE; + end; + end; + end; + Sender.SetTransparent( + {$IFDEF USE_FLAGS} G2_ClassicTransparent in Sender.fFlagsG2 + {$ELSE} Sender.fClassicTransparent {$ENDIF} ); + exit; + end; + end; + end; end; //********************* Attaching to message WM_THEMECHANGED *****************// -procedure Attach_WM_THEMECHANGED(Sender : PControl); -begin - Sender.AttachProc(WndXP_WM_THEMECHANGED); +type TSenderProc = procedure(Sender: PControl); +{$IFDEF ASM_VERSION} +procedure Attach_WM_THEMECHANGED(Sender : PControl; const XP_Themes_for: TSenderProc); +asm + {$IFDEF USE_FLAGS} + MOV CX, word ptr [EAX].TControl.fFlagsG2 + AND CX, not(1 shl G3_ClassicTransparent)shl 8 or (1 shl G2_Transparent) + OR CL, CH + MOV [EAX].TControl.fFlagsG3, CL + {$ELSE} + MOV CL, [EAX].TControl.fTransparent + MOV [EAX].TControl.fClassicTransparent, CL + {$ENDIF} + PUSH EDX + PUSH EAX + MOV EDX, offset[WndXP_WM_THEMECHANGED] + CALL TControl.AttachProc + POP EAX + POP EDX + CALL EDX end; +{$ELSE PASCAL} +procedure Attach_WM_THEMECHANGED(Sender : PControl; const XP_Themes_for: TSenderProc); +begin + {$IFDEF USE_FLAGS} + if G2_Transparent in Sender.fFlagsG2 then + Sender.fFlagsG3 := Sender.fFlagsG3 + [G3_ClassicTransparent] + else + Sender.fFlagsG3 := Sender.fFlagsG3 - [G3_ClassicTransparent]; + {$ELSE} Sender.fClassicTransparent := Sender.fTransparent; {$ENDIF} + Sender.AttachProc(WndXP_WM_THEMECHANGED); + XP_Themes_for(Sender); +end; +{$ENDIF ASM_VERSION} //********************************* End File *********************************//