paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-06 23:38:02 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Adds TProgressBar support for lcl-fpgui. Issue #24167, patch from Graeme

Browse Source 
git-svn-id: trunk@40666 -
This commit is contained in:
juha 2013-03-29 18:39:18 +00:00
parent 9144f86c55
commit dc58fc0884
4 changed files with 62 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/interfaces/fpgui/fpguiint.pp
View File

@ -112,6 +112,7 @@ uses
FpGuiWSForms,
FpGuiWSMenus,
FpGuiWSStdCtrls,
FpGuiWSComCtrls,
////////////////////////////////////////////////////
Graphics, buttons, Menus;

38
lcl/interfaces/fpgui/fpguiwscomctrls.pp
View File

@ -101,6 +101,12 @@ type
private
protected
public
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure ApplyChanges(const AProgressBar: TCustomProgressBar); override;
class procedure SetPosition(const AProgressBar: TCustomProgressBar; const NewPosition: integer); override;
// class procedure SetStyle(const AProgressBar: TCustomProgressBar; const NewStyle: TProgressBarStyle); override;
end;
{ TFpGuiWSCustomUpDown }
@ -162,6 +168,38 @@ type
implementation
uses
fpg_progressbar;
{ TFpGuiWSProgressBar }
class function TFpGuiWSProgressBar.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
begin
Result := TLCLIntfHandle(TFPGUIPrivateProgressBar.Create(AWinControl, AParams));
end;
class procedure TFpGuiWSProgressBar.DestroyHandle(const AWinControl: TWinControl);
begin
TFPGUIPrivateProgressBar(AWinControl.Handle).Free;
AWinControl.Handle := 0;
end;
class procedure TFpGuiWSProgressBar.ApplyChanges(
const AProgressBar: TCustomProgressBar);
begin
SetPosition(AProgressBar, AProgressBar.Position);
end;
class procedure TFpGuiWSProgressBar.SetPosition(
const AProgressBar: TCustomProgressBar; const NewPosition: integer);
var
lProgressBar: TfpgProgressBar;
begin
lProgressBar := TFPGUIPrivateProgressBar(AProgressBar.Handle).ProgressBar;
lProgressBar.Position := NewPosition;
end;
{ TFpGuiWSCustomNotebook }
class function TFpGuiWSCustomNotebook.CreateHandle(

3
lcl/interfaces/fpgui/fpguiwsfactory.pas
View File

@ -175,7 +175,8 @@ end;
function RegisterCustomProgressBar: Boolean; alias : 'WSRegisterCustomProgressBar';
begin
Result := False;
RegisterWSComponent(TCustomProgressBar, TFpGuiWSProgressBar);
Result := True;
end;
function RegisterCustomUpDown: Boolean; alias : 'WSRegisterCustomUpDown';

22
lcl/interfaces/fpgui/fpguiwsprivate.pp
View File

@ -42,7 +42,7 @@ uses
fpg_widget, fpg_form, fpg_button, fpg_combobox, fpg_dialogs,
fpg_edit, fpg_checkbox, fpg_radiobutton, fpg_tab, fpg_memo,
fpg_menu, fpg_label, fpg_listbox, fpg_panel,
fpg_popupwindow, fpg_base, fpguiproc;
fpg_popupwindow, fpg_base, fpg_progressbar, fpguiproc;
type
@ -471,6 +471,14 @@ type
procedure PopUp(X, Y: Integer);
end;
TFPGUIPrivateProgressBar = class(TFPGUIPrivateWidget)
public
procedure CreateWidget(const AParams: TCreateParams); override;
public
function ProgressBar: TfpgProgressBar;
end;
var
GlobalMouseCursorPos: TPoint;
GlobalMouseCursorPosWidget: TFPGUIPrivateWidget;
@ -480,6 +488,18 @@ implementation
uses
LCLMessageGlue;
{ TFPGUIPrivateProgressBar }
procedure TFPGUIPrivateProgressBar.CreateWidget(const AParams: TCreateParams);
begin
Widget := TfpgProgressBar.Create(GetParentContainerWidget());
end;
function TFPGUIPrivateProgressBar.ProgressBar: TfpgProgressBar;
begin
Result := TfpgProgressBar(Widget);
end;
{ TFPGUIPrivate }
function TFPGUIPrivate._AddRef: longint; stdcall;