paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-03 22:20:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed: tarrow crash in win32

Browse Source 
added: interface function DrawArrow to draw themed arrow

git-svn-id: trunk@5211 -
This commit is contained in:
micha 2004-02-20 19:52:18 +00:00
parent 33dd6d0185
commit 6a9c435997
7 changed files with 51 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/arrow.pp
View File

@ -56,6 +56,7 @@ Type
procedure SetArrowType(const AValue: TArrowType);
procedure SetProps;
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -79,6 +80,9 @@ procedure Register;
implementation
uses
InterfaceBase;
procedure Register;
begin
RegisterComponents('Misc',[TArrow]);
@ -107,6 +111,11 @@ begin
SetProps;
end;
procedure TArrow.Paint;
begin
InterfaceObject.DrawArrow(Self, Canvas);
end;
procedure TArrow.InitializeWnd;
begin
inherited InitializeWnd;

8
lcl/include/intfbaselcl.inc
View File

@ -109,6 +109,10 @@ begin
DeleteObject(Clip);
end;
procedure TInterfaceBase.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
begin
end;
function TInterfaceBase.Frame(DC: HDC; const ARect: TRect) : integer;
begin
Result:= 0;
@ -615,6 +619,10 @@ end;
{ =============================================================================
$Log$
Revision 1.19 2004/02/20 19:52:18 micha
fixed: tarrow crash in win32
added: interface function DrawArrow to draw themed arrow
Revision 1.18 2004/02/19 05:07:17 mattias
CreateBitmapFromRawImage now creates mask only if needed

9
lcl/include/lclintf.inc
View File

@ -106,6 +106,11 @@ begin
Result := InterfaceObject.DCClipRegionValid(DC);
end;
procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent);
begin
InterfaceObject.DrawArrow(Arrow, Canvas);
end;
function Frame(DC: HDC; const ARect: TRect): Integer;
begin
Result:= InterfaceObject.Frame(DC, ARect);
@ -512,6 +517,10 @@ end;
{ =============================================================================
$Log$
Revision 1.17 2004/02/20 19:52:18 micha
fixed: tarrow crash in win32
added: interface function DrawArrow to draw themed arrow
Revision 1.16 2004/02/19 05:07:17 mattias
CreateBitmapFromRawImage now creates mask only if needed

5
lcl/include/lclintfh.inc
View File

@ -55,6 +55,7 @@ function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): H
function CreateRegionCopy(SrcRGN: hRGN): hRGN; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function DCClipRegionValid(DC: HDC): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
function GetBitmapRawImageDescription(Bitmap: HBITMAP; Desc: PRawImageDescription): boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF}
@ -148,6 +149,10 @@ procedure RaiseLastOSError;
{ =============================================================================
$Log$
Revision 1.17 2004/02/20 19:52:18 micha
fixed: tarrow crash in win32
added: interface function DrawArrow to draw themed arrow
Revision 1.16 2004/02/19 05:07:17 mattias
CreateBitmapFromRawImage now creates mask only if needed

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

@ -28,6 +28,11 @@
//##apiwiz##sps## // Do not remove
procedure TWin32Object.DrawArrow(Arrow: TComponent; Canvas: TPersistent);
begin
Windows.DrawFrameControl(TCanvas(Canvas).Handle, TControl(Arrow).ClientRect, DFC_MENU, DFCS_MENUARROW);
end;
{------------------------------------------------------------------------------
Function: GetAcceleratorString
Params: AVKey:
@ -189,6 +194,10 @@ end;
{ =============================================================================
$Log$
Revision 1.11 2004/02/20 19:52:18 micha
fixed: tarrow crash in win32
added: interface function DrawArrow to draw themed arrow
Revision 1.10 2004/02/05 13:53:38 mattias
fixed GetConstraints for win32 intf

6
lcl/interfaces/win32/win32lclintfh.inc
View File

@ -27,6 +27,8 @@
}
//##apiwiz##sps## // Do not remove
procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); override;
function GetAcceleratorString(const AVKey: Byte; const AShiftState: TShiftState): String; override;
function GetControlConstraints(Constraints: TObject): boolean; override;
function GetListBoxIndexAtY(ListBox: TComponent; y: integer): integer; override;
@ -42,6 +44,10 @@ procedure StatusBarUpdate(StatusBar: TObject); override;
{ =============================================================================
$Log$
Revision 1.10 2004/02/20 19:52:18 micha
fixed: tarrow crash in win32
added: interface function DrawArrow to draw themed arrow
Revision 1.9 2004/02/05 13:53:38 mattias
fixed GetConstraints for win32 intf

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

@ -2089,7 +2089,7 @@ Begin
WindowTitle := StrCaption;
Flags := Flags Or ES_AUTOHSCROLL;
End;
csFixed:
csArrow, csFixed:
Begin
Assert(False, 'Trace:TODO: Figure out what component style csFixed is and code the component. No component created.');
pClassName := @ClsName;
@ -2297,12 +2297,6 @@ Begin
MoveWindow(Handle, R.Right - Left, R.Bottom - Top, (R.Right - R.Left) - (Left Div 2), (R.Bottom - R.Top) - (Top Div 2), True);
Window := Handle;
End;
csArrow:
Begin
Assert(False, 'Trace:TODO: TWin32Object.CreateComponent - Figure out what a csArrow is and code it');
Assert(False, 'Trace:TWin32Object.CreateComponent - Creating a cursor. This will have to be good enough for now.');
Window := LoadCursor(System.HInstance, IDC_UPARROW);
End;
csFileDialog, csOpenFileDialog, csSaveFileDialog,
csColorDialog, csFontDialog:
Begin
@ -3007,6 +3001,10 @@ End;
{
$Log$
Revision 1.170 2004/02/20 19:52:18 micha
fixed: tarrow crash in win32
added: interface function DrawArrow to draw themed arrow
Revision 1.169 2004/02/19 14:37:20 micha
fixed: memo eats return key (from vincent)