IDE carbon: improved designer drawing

git-svn-id: trunk@14016 -
This commit is contained in:
tombo 2008-02-07 13:37:47 +00:00
parent 1760486308
commit 31ca02018a
6 changed files with 74 additions and 47 deletions

View File

@ -35,6 +35,10 @@ interface
{off $DEFINE VerboseDesigner}
{off $DEFINE VerboseDesignerDraw}
{$IFDEF LCLCarbon}
{$DEFINE CantPaintOnIdle}
{$ENDIF}
uses
Classes, SysUtils, Math, LCLProc, LCLType, LResources, LCLIntf, LMessages,
Forms, Controls, GraphType, Graphics, Dialogs, ExtCtrls, Menus, ClipBrd,
@ -1160,15 +1164,24 @@ begin
end;
LastPaintSender:=Sender;
// client grid
if (Sender is TWinControl)
and (csAcceptsControls in Sender.ControlStyle) then begin
PaintClientGrid(TWinControl(Sender),DDC);
if IsDesignerDC(Form.Handle, TheMessage.DC) then
begin
DoPaintDesignerItems;
end
else
begin
// client grid
if (Sender is TWinControl)
and (csAcceptsControls in Sender.ControlStyle) then begin
PaintClientGrid(TWinControl(Sender),DDC);
end;
{$IFNDEF CantPaintOnIdle}
if not EnvironmentOptions.DesignerPaintLazy then
DoPaintDesignerItems;
{$ENDIF}
end;
if not EnvironmentOptions.DesignerPaintLazy then
DoPaintDesignerItems;
// clean up
DDC.Clear;
end;
@ -2418,9 +2431,12 @@ begin
end;
procedure TDesigner.DrawDesignerItems(OnlyIfNeeded: boolean);
{$IFNDEF CantPaintOnIdle}
var
DesignerDC: HDC;
{$ENDIF}
begin
{$IFNDEF CantPaintOnIdle}
if OnlyIfNeeded and (not (dfNeedPainting in FFlags)) then exit;
Exclude(FFlags,dfNeedPainting);
@ -2432,6 +2448,7 @@ begin
DoPaintDesignerItems;
DDC.Clear;
ReleaseDesignerDC(Form.Handle,DesignerDC);
{$ENDIF}
end;
procedure TDesigner.CheckFormBounds;

View File

@ -202,6 +202,23 @@ begin
Result := True;
end;
{------------------------------------------------------------------------------
Method: IsDesignerDC
Params: WindowHandle - Handle of window
DC - Handle of device context
Returns: If the device context is designer
------------------------------------------------------------------------------}
function TCarbonWidgetSet.IsDesignerDC(WindowHandle: HWND; DC: HDC): Boolean;
begin
Result := False;
{$IFDEF VerboseLCLIntf}
DebugLn('TCarbonWidgetSet.IsDesignerDC Handle: ' + DbgS(WindowHandle), ' DC: ' + DbgS(DC));
{$ENDIF}
if not CheckWidget(WindowHandle, 'IsDesignerDC', TCarbonDesignWindow) then Exit;
Result := DC = HDC(TCarbonDesignWindow(WindowHandle).GetDesignContext);
end;
{------------------------------------------------------------------------------
Method: PromptUser
Params: DialogCaption - Dialog caption

View File

@ -43,6 +43,8 @@ function GetLCLOwnerObject(Handle: HWnd): TObject; override;
function IntfSendsUTF8KeyPress: boolean; override;
function IsDesignerDC(WindowHandle: HWND; DC: HDC): Boolean; override;
function PromptUser(const DialogCaption : string;
const DialogMessage : string;
DialogType : LongInt;

View File

@ -172,7 +172,6 @@ type
private
FDesignControl: HIViewRef;
FDesignContext: TCarbonContext;
FDesignBitmap: TCarbonBitmap;
procedure BringDesignerToFront;
protected
procedure RegisterEvents; override;
@ -393,8 +392,7 @@ function CarbonDesign_Draw(ANextHandler: EventHandlerCallRef;
AWidget: TCarbonWidget): OSStatus; {$IFDEF darwin}mwpascal;{$ENDIF}
var
ADesignWindow: TCarbonDesignWindow;
AContext: TCarbonDeviceContext;
ABitmap: TCarbonBitmap;
AStruct: PPaintStruct;
begin
{$IFDEF VerbosePaint}
Debugln('CarbonDesign_Draw ', DbgSName(AWidget.LCLObject));
@ -402,25 +400,31 @@ begin
ADesignWindow := (AWidget as TCarbonDesignWindow);
AContext := TCarbonControlContext.Create(AWidget);
ADesignWindow.FDesignContext := TCarbonControlContext.Create(ADesignWindow);
try
// set canvas context
if OSError(
GetEventParameter(AEvent, kEventParamCGContextRef, typeCGContextRef, nil,
SizeOf(CGContextRef), nil, @AContext.CGContext),
SizeOf(CGContextRef), nil, @(ADesignWindow.FDesignContext.CGContext)),
'CarbonDesign_Draw', SGetEvent, 'kEventParamCGContextRef') then Exit;
// let carbon draw/update
Result := CallNextEventHandler(ANextHandler, AEvent);
// draw designer stuff
ABitmap := ADesignWindow.FDesignBitmap;
if ADesignWindow.FDesignContext <> nil then
AContext.StretchDraw(0, 0, ABitmap.Width, ABitmap.Height,
TCarbonBitmapContext(ADesignWindow.FDesignContext),
0, 0, ABitmap.Width, ABitmap.Height, nil, 0, 0, SRCCOPY);
New(AStruct);
FillChar(AStruct^, SizeOf(TPaintStruct), 0);
AStruct^.hdc := HDC(ADesignWindow.FDesignContext);
try
{$IFDEF VerbosePaint}
DebugLn('CarbonDesign_Draw LM_PAINT to ', DbgSName(AWidget.LCLObject));
{$ENDIF}
LCLSendPaintMsg(AWidget.LCLObject, HDC(ADesignWindow.FDesignContext), AStruct);
finally
Dispose(AStruct);
end;
finally
AContext.Free;
FreeAndNil(ADesignWindow.FDesignContext);
end;
{$IFDEF VerbosePaint}
Debugln('CarbonDesign_Draw end ', DbgSName(AWidget.LCLObject));
@ -504,9 +508,6 @@ begin
DisposeControl(FDesignControl);
inherited;
FreeAndNil(FDesignContext);
FreeAndNil(FDesignBitmap);
end;
{------------------------------------------------------------------------------
@ -560,29 +561,9 @@ end;
Returns: Context for drawing designer stuff
------------------------------------------------------------------------------}
function TCarbonDesignWindow.GetDesignContext: TCarbonContext;
var
R: TRect;
begin
GetClientRect(R);
OffsetRect(R, -R.Left, -R.Top);
if FDesignBitmap <> nil then
if (R.Right - R.Left = FDesignBitmap.Width) and (R.Bottom - R.Top = FDesignBitmap.Height) then
begin
// the designer area has not been resized - clear it only
CGContextClearRect(FDesignContext.CGContext, RectToCGRect(R));
Result := FDesignContext;
Exit;
end;
FreeAndNil(FDesignContext);
FreeAndNil(FDesignBitmap);
FDesignContext := TCarbonBitmapContext.Create;
FDesignBitmap := TCarbonBitmap.Create(R.Right - R.Left, R.Bottom - R.Top, 32, 32, cbaDQWord, cbtARGB, nil);
(FDesignContext as TCarbonBitmapContext).Bitmap := FDesignBitmap;
Result := FDesignContext;
if FDesignContext <> nil then Result := FDesignContext
else Result := DefaultContext;
end;
{------------------------------------------------------------------------------
@ -592,8 +573,7 @@ end;
------------------------------------------------------------------------------}
procedure TCarbonDesignWindow.ReleaseDesignContext;
begin
// redraw designer
Invalidate;
// nothing
end;
{ TCarbonCustomControl }

View File

@ -606,6 +606,7 @@ end;
procedure TCarbonControl.Invalidate(Rect: PRect);
var
I: Integer;
R: TRect;
begin
if Rect = nil then
begin
@ -614,9 +615,13 @@ begin
HiViewSetNeedsDisplay(Frames[I], True), Self, SInvalidate, SViewNeedsDisplay);
end
else
begin
R := Rect^;
InflateRect(R, 1, 1);
OSError(
HiViewSetNeedsDisplayInRect(Content, RectToCGRect(Rect^), True), Self,
HiViewSetNeedsDisplayInRect(Content, RectToCGRect(R), True), Self,
SInvalidate, SViewNeedsDisplayRect);
end;
end;
{------------------------------------------------------------------------------

View File

@ -1124,14 +1124,20 @@ end;
Invalidates the specified rect or entire area of window content
------------------------------------------------------------------------------}
procedure TCarbonWindow.Invalidate(Rect: PRect);
var
R: TRect;
begin
if Rect = nil then
OSError(HiViewSetNeedsDisplay(HIViewRef(Content), True), Self, SInvalidate,
SViewNeedsDisplay)
else
begin
R := Rect^;
InflateRect(R, 1, 1);
OSError(
HiViewSetNeedsDisplayInRect(HIViewRef(Content), RectToCGRect(Rect^), True),
HiViewSetNeedsDisplayInRect(HIViewRef(Content), RectToCGRect(R), True),
Self, SInvalidate, SViewNeedsDisplayRect);
end;
end;
{------------------------------------------------------------------------------