среда, 25 декабря 2013 г.

Ссылка. Ответ на задачку №2, часть первая

http://alexander-bagel.blogspot.ru/2013/12/2_23.html

На самом деле я про проблему - "знал, но забыл" :-)

СПАСИБО автору, что напомнил и освежил в памяти.

Это кстати одна из мотиваций того почему я написал "собственную канву" и стараюсь пользоваться исключительно ею.

И ещё я писал вот что - http://18delphi.blogspot.ru/2013/04/vcl.html

Что до собственной канвы...

Она правда "сложна". Но оно того стоит.



Вот её интерфейсная секция:

type
  Tl3Canvas = class(Tl3CanvasPrim, Il3Canvas, Il3InfoCanvas, Il3Font, Il3EffectiveColors)
   {* - объект реализующий свой уровень абстракции над TCanvas и Device Context (hDC). }
    private
    // internal fields
      f_OldBrushChange  : TNotifyEvent;
      f_OldFontChange   : TNotifyEvent;
      f_CheckingColors  : Long;
      f_CheckingDrawing : Long;
      f_SuffixedFont    : Boolean;
    private
    // property fields
      f_Zoom           : Long;
      f_FrameLines     : Il3FrameLines;
      f_etoFlags       : Word;
      f_Invert         : Long;
      f_Fore           : Long;
      f_Filled         : Tl3Region;
      f_Drawing        : Long;
      f_BackColor      : TColor;
      f_TextColor      : TColor;
      f_FontIndex      : Tl3FontIndex;
      f_FontIndexSet   : Tl3FontIndexes;
      f_WindowOrg      : Tl3Point;
      f_WindowOrgInited : Boolean;
      f_ClipRect       : Tl3Rect;
      f_ClipRectS      : Tl3SRect;
      f_Kerning        : Tl3MemoryPool;
      f_Canvas         : TCanvas;
      f_AlienCanvas    : Bool;
      f_Owner          : TObject;
      f_Painter        : Il3HAFPainter;
      f_AverageCharHeight  : Long;
      f_AverageCharWidth   : Long;
      f_pxAverageCharWidth : Long;
      f_TextMetrics        : TTextMetric;
      f_TextMetricsValid   : Bool;
      f_PageOrientation    : Tl3PageOrientation;
      f_SectionExtent      : Tl3Point;
      f_ConvertBuf         : PAnsiChar;
      f_Tabs               : Long;
      f_TabOffset          : Long;
      f_TabStops           : Il3TabStops;
      f_NotFocused         : Bool;
      f_DC                 : hDC;
      f_RegionBottomRight  : Tl3SPoint;
      f_WOs                : Tl3LongintList;
      f_Rgns               : Tl3LongintList;
      f_BCs                : Tl3LongintList;
      f_FCs                : Tl3LongintList;
      f_SaveOrientation    : Tl3PageOrientation;
      f_Font               : Il3Font;
      f_PasswordChar       : AnsiChar;
      f_OutString          : Tl3String;
      f_ConvertTable       : array [Bool] of Tl3MemoryPool;
      f_VirtualCanvas      : Il3Canvas;
    protected
    // property fields
      f_DCFlag             : TevDCFlag;
    private
    // event fields
      f_OnDrawSpecialChange : TNotifyEvent;
    protected
    // property methods
      function Get_EffectiveColors: Il3EffectiveColors;
        {-}
      function Get_FontColor: Tl3Color;
        {-}
   function  Get_PasswordChar: AnsiChar;
   procedure Set_PasswordChar(aValue: AnsiChar);
        {-}
      function  pm_GetInvert: Bool;
        {-}
      function  pm_GetDrawing: Bool;
        {-}
      function  pm_GetBackColor: TColor;
      procedure pm_SetBackColor(Value: TColor);
        {-}
      function  pm_GetDC: hDC;
        override;
      procedure pm_SetDC(aValue: hDC);
        {-}
      function  pm_GetTextColor: TColor;
      procedure pm_SetTextColor(Value: TColor);
        {-}
      function  pm_GetFontIndexSet: Tl3FontIndexes;
      procedure pm_SetFontIndexSet(Value: Tl3FontIndexes);
        {-}
      function  Get_Index: Tl3FontIndex;
      procedure pm_SetFontIndex(Value: Tl3FontIndex);
        {-}
      function  pm_GetWindowOrg: Tl3Point;
        override;
      procedure pm_SetWindowOrg(const Value: Tl3Point);
        override;
        {-}
      function  pm_GetSWindowOrg: Tl3SPoint;
        override;
      procedure pm_SetSWindowOrg(const Value: Tl3SPoint);
        override;
        {-}
      function  pm_GetClipRect: Tl3Rect;
        override;
      procedure pm_SetClipRect(const Value: Tl3Rect);
        override;
        {-}
      function  pm_GetGlobalClipRect: Tl3Rect;
        override;
        {-}
      function  pm_GetDrawSpecial: Bool;
      procedure pm_SetDrawSpecial(Value: Bool);
        {-}
      function  pm_GetPrinted: Bool;
      procedure pm_SetPrinted(Value: Bool);
        {-}
      procedure pm_SetNotFocused(Value: Bool);
        {-}
      function  pm_GetShowCursor: Bool;
      procedure pm_SetShowCursor(Value: Bool);
        {-}
      function  pm_GetDrawEnabled: Bool;
        {-}
      procedure pm_SetDrawEnabled(Value: Bool);
        {-}
      function  pm_GetCanvas: TCanvas;
      procedure pm_SetCanvas(Value: TCanvas);
        {-}
      function pm_GetFrameLines: Il3FrameLines;
        {-}
      procedure pm_SetPainter(const aValue: Il3HAFPainter);
        {-}
      function  pm_GetVCLFont: TFont;
      procedure pm_SetVCLFont(Value: TFont);
        {-}
      function  pm_GetBrush: TBrush;
      procedure pm_SetBrush(Value: TBrush);
        {-}
      function  pm_GetPen : TPen;
      procedure pm_SetPen(const aValue : TPen);
        {-}
(*      function  GetOwner: TPersistent;
        virtual{override};
        {-}*)
      procedure DoSetOwner(Value: TObject);
        //virtual{override};
        {-}
      function  pm_GetZoom: Long;
      procedure pm_SetZoom(Value: Long);
        {-}
      function  pm_GetPageSetup: Il3PageSetup;
        {-}
      function  pm_GetPenWidth: Long;
        {-}
      function  pm_GetPageOrientation: Tl3PageOrientation;
      procedure pm_SetPageOrientation(Value: Tl3PageOrientation);
        {-}
      function  pm_GetSectionExtent: Tl3Point;
      procedure pm_SetSectionExtent(const Value: Tl3Point);
        {-}
      function pm_GetetoFlags: Word;
        {-}
      function GetGlobalClipRectWithZoom: Tl3Rect; override;
        {-}
    protected
    // interface methods
      // Il3Font
      function  Get_ForeColor: TColor;
      procedure Set_ForeColor(Value: TColor);
        {-}
      function  Get_BackColor: TColor;
      procedure Set_BackColor(Value: TColor);
        {-}
      function  Get_Height: Long;
      procedure Set_Height(Value: Long);
        {-}
      function  Get_Name: TFontName;
      procedure Set_Name(const Value: TFontName);
        {-}
      function  Get_Pitch: TFontPitch;
      procedure Set_Pitch(Value: TFontPitch);
        {-}
      function  Get_Size: Long;
      procedure Set_Size(Value: Long);
        {-}
      function  Get_Style: TFontStyles;
      procedure Set_Style(Value: TFontStyles);
        {-}
      procedure Il3Font.Set_Index = pm_SetFontIndex;
        {-}
      function  Get_Bold: Boolean;
      procedure Set_Bold(Value: Boolean);
        {-}
      function  Get_Italic: Boolean;
      procedure Set_Italic(Value: Boolean);
        {-}
      function  Get_Underline: Boolean;
      procedure Set_Underline(Value: Boolean);
        {-}
      function  Get_Strikeout: Boolean;
      procedure Set_Strikeout(Value: Boolean);
        {-}
      function  AssignFont(aFont: TFont): Bool;
        {-}
      function  IsAtomic: Boolean;
        {-}
      function  FM: Il3FontMetrics;
        {-}
      procedure Assign2Font(const aFont: Il3Font);
        {-}
      function HF: hFont;
        {-}  
      // Il3InfoCanvas 
      function  Get_Font: Il3Font;
        {-}
      procedure Set_Font(const Value: Il3Font);
        {-}
      function AdjustMarginsByPrintableArea(const aMargins: Tl3_Rect): Tl3_Rect;
        {* Откорректировать поля с учетом непечатаемой области }
    protected
    // internal methods
      procedure DoDrawLineTo(aX, aY: Integer);
        {-}
      procedure CheckColors;
        {-}
      procedure BrushChanged(ABrush: TObject);
        {-}
      procedure FontChanged(AFont: TObject);
        {-}
      function  xCheckFilled: Tl3Region;
        {-}
      procedure AddRgn(const aRgn: Il3Region);
        virtual;
        {-}
      procedure FreeDC;
        {-}
      procedure FreeAlienDC(aDC: hDC);
        virtual;
        {-}
      function AsIl3Canvas: Il3Canvas; override;
      function  CheckDrawing: Bool;
        {-}
      function  GetAlienDC: hDC;
        virtual;
        {-}  
      function  DrawingIsValid: Bool;
        {* - проверяет возможно ли рисование. }
      function  DeviceCaps(anIndex: Integer): Integer;
        override;
        {* - возвращает свойства устройства рисования. }
      procedure DoStartPage;
        virtual;
        {-}
      procedure StartPage;
        {-}
      procedure CheckOrientation;
        {-}  
      procedure Cleanup;
        override;
        {-}
      procedure FillRectPrim(const R: TRect);
        virtual;
        {-}
      function  WO(const aRect: Tl3Rect): Tl3SRect;
        overload;
        {-}
      function  WO(const aPt: Tl3Point): Tl3SPoint;
        overload;
        {-}
      function  WO(const aPt: Tl3SPoint): Tl3SPoint;
        overload;
        {-}
      procedure KerningTextOut(const P: Tl3Point;
                               const R: Tl3Rect;
                               const S: Tl3PCharLenPrim);
        overload;
        {-}
      procedure KerningTextOut(const P: Tl3SPoint;
                               const R: Tl3SRect;
                               const S: Tl3PCharLenPrim);
        overload;
        {-}
      function  GetTabWidth: Long;
        {-}
      function  KerningTextExtent(const S : Tl3PCharLenPrim): Tl3Point;
        virtual;
        {-}
      function  TabOffset: Long;
        {-}
      procedure RestoreTabInfo(const aTabInfo: Il3TabInfo);
        {-}
      procedure AssignDeviceCaps;
        override;
        {-}
      function  IsPreview: Boolean;
        virtual;
        {-}
      function GetClientRect: Tl3Rect;
        {-}
      function DoGetClientRect: Tl3Rect;
        virtual;
        {-}
      procedure Invalidate;
        virtual;
        {-}
      function  IsVirtual: Boolean;
        virtual;
        {-}
      procedure FireDCSetToNull;
        virtual;
        {-}
      procedure MakeScreenDC;
        {-}
      function  GetCaret: Il3Caret;
        virtual;
        {-}
      procedure DoAddRect(const aRect: Tl3SRect);
        {-}
      procedure DoAddRectPrim(const aRect: Tl3SRect);
        virtual;
        {-}
      procedure StartRegion;
        {-}
      procedure FinishRegion;
        {-}
      function  pm_GetRegionBottomRight: Tl3Point;
        {-}
      procedure RecordRegionBottomPrim(const aBottom: Tl3SPoint);
        {-}
      procedure PushWO;
        {-}
      procedure PopWO;
        {-}
      procedure PushBC;
        {-}
      function  TopBC: TColor;
        {-}
      procedure PopBC;
        {-}
      procedure PushFC;
        {-}
      procedure PopFC;
        {-}
      function CheckOutString(const aStr: Tl3PCharLen): Tl3PCharLen;
        {-}
      function CheckConvertTable(OEM : Bool): PAnsiChar;
        {-}
      function CheckConvertString(const aStr : Tl3PCharLen): Tl3PCharLen;
        {-}
      procedure InitFields;
        override;
        {-}
    protected
    // internal properties
      property VCLFont: TFont
        read pm_GetVCLFont
        write pm_SetVCLFont;
        {-}
    public
    // public methods
      constructor CreateOwned(anOwner : TObject);
        {-}
      constructor CreateForPrinting(const aPrinter: Il3Printer);
        {-}
      class function Make: Il3Canvas;
        {-}
      class function MakeForPrinting(const aPrinter: Il3Printer): Il3InfoCanvas;
        {-}
      class function MakeForScreen: Il3InfoCanvas;
        {-}
      procedure SetCanvas(Value: TCanvas; Alien: Bool);
        virtual;
        {-}
      procedure AddRect(const aRect: Tl3SRect);
        {-}
      procedure DoFillForeRect(const R: Tl3SRect);
        virtual;
        {-}
      procedure FillForeRect(const R: Tl3SRect);
        {-}
      procedure FillRect(const R: Tl3SRect);
        overload;
        {-}
      procedure FillRect(const R: Tl3Rect);
        overload;
        {-}
      function  FillRgn(const Region: Il3Region): Bool;
        {-}
      procedure ExtTextOut(const aPt    : Tl3Point;
                           const aRect  : Tl3Rect;
                           const aSt    : Tl3PCharLenPrim;
                           aFl          : Tl3TextFormatFlag = l3_tffLeft;
                           aKerning     : PInteger = nil);
        overload;
        {-}
      procedure ExtTextOut(const P: Tl3SPoint;
                           const R: Tl3SRect;
                           const S: Tl3PCharLenPrim;
                           aFl: Tl3TextFormatFlag = l3_tffLeft;
                           aKerning: PInteger = nil);
        overload;
        {-}
      function  CaretLineOut(const aSt    : Tl3PCharLenPrim;
                             LineHeight   : Long;
                             aHidden      : Boolean;
                             var CaretPos : Long): Tl3Point;
        {* - выводит строку текста высотой LineHeight, со сдвигом курсора отрисовки.
             устанавливает курсор в CaretPos.
             Возвращает размеры выведенной строки. }
      function  DrawText(const aSt : Tl3PCharLenPrim;
                         var R     : TRect;
                         aFormat    : uInt;
                         AFl : TObject = nil): Il3MultiLines;
        {-}  
      function  StringOut(const P: Tl3Point; const Text: Tl3WString): Tl3Point;
        {-}
      function  InvertColor(aColor: TColor): TColor;
        {-}
      procedure StretchDraw(const R: Tl3Rect; Graphic: TGraphic);
        {-}
      function  LP2DP(const P: Tl3_Point; NeedZoom : Bool = false): Tl3SPoint;
        {-}
      function  LR2DR(const R: Tl3Rect): Tl3SRect;
        {-}
      function  DR2LR(const R: Tl3SRect): Tl3Rect;
        {-}
      function  TextExtent(const S : Tl3PCharLenPrim;
                           aNoTabs : Boolean = false): Tl3Point;
        {* - возвращает размеры строки текста в дюймах. }
      function  Pos2Index(W: Long; const S: Tl3PCharLen): Long;
        {* - находит индекс символа на рассоянии W дюймов от начала строки S. }
      function  Pos2IndexQ(W           : Long;
                           const S     : Tl3PCharLen;
                           var aNoTabs : Boolean): Long;
        {* - находит индекс символа на рассоянии W дюймов от начала строки S. }
      function  pxAverageCharWidth: Long;
        {* - средняя ширина символов контекста в пикселях. }
      function  AverageCharWidth: Long;
        {* - средняя ширина символов контекста в дюймах. }
      function  AverageCharHeight: Long;
        {* - средняя высота символов контекста в дюймах. }
      procedure MoveTo(const aPt: Tl3Point);
        overload;
        {-}
      procedure LineTo(const aPt: Tl3Point);
        overload;
        {-}
      procedure MoveTo(const aPt: Tl3SPoint);
        overload;
        {-}
      procedure LineTo(const aPt: Tl3SPoint);
        overload;
        {-}
      procedure Line(const A, B: Tl3Point);
        overload;
        {* - нарисовать линию. }
      procedure Line(const A, B: Tl3SPoint);
        overload;
        {* - нарисовать линию. }
      function  CaretExtent: Tl3Point;
        {-}
      procedure StartTabs(out theTabInfo  : Il3TabInfo;
                          const aTabStops : Il3TabStops;
                          aTabOffset      : Long = 0);
        overload;
        {-}
      procedure StartTabs(out theTabInfo : Il3TabInfo;
                          const aTabInfo : Il3TabInfo);
        overload;
        {-}
      procedure FinishTabs(var aTabInfo: Il3TabInfo);
        {-}
      function  TabInfo: Il3TabInfo;
        {-}
      function  EQ(const aCanvas: Il3InfoCanvas): Bool;
        {-}
      function  NeedOpenRealPage(aDoc : Boolean; ByWidth: Boolean = false): Tl3OpenPageResult;
        virtual;
        {-}
      procedure StartPrinterPage(aDoc : Boolean);
        virtual;
        {-}
      procedure BeginPaint;
        {-}
      procedure StartObject(anObjectID: Integer);
        {-}
      procedure DoStartObject(anObjectID: Integer);
        virtual;
        {-}
      procedure DoSetPageTop;
        virtual;
        {-}
      procedure SetPageTop;
        {-}
      procedure DoEndPaint;
        virtual;
        {-}
      procedure EndPaint;
        {-}
      procedure BeginInvert;
        {-}
      procedure EndInvert;
        {-}
      function  CreateRectRgn(const aRect: Tl3SRect): Tl3Rgn;
        {-}
      function  OffsetRgn(const Rgn: Il3Region; const Pt: Tl3Point): Integer;
        {-}
      procedure FillEmptyRect(const R: Tl3Rect);
        overload;
        virtual;
        {-}
      procedure FillEmptyRect(const R: Tl3SRect);
        overload;
        virtual;
        {-}
      function  GetKerning(const aSt : Tl3PCharLenPrim;
                           aKerning  : PLong): Tl3Point;
        {-}
      function  TextOut(const P : Tl3Point;
                        const S : Tl3PCharLen;
                        FC      : TColor = clDefault;
                        BC      : TColor = clDefault): Tl3Point;
        {-}
      procedure SetDC(DC: HDC; Flag: TevDCFlag);
        {-}
      function  CheckKerning(Size: Long): Pointer;
        {-}
      function  NewPage(ByWidth: Bool = false): Boolean;
        {-}
      procedure SetCaret(const Origin, Extent: Tl3Point; aHidden: Bool = false);
        {-}
      procedure IncCaret(aDeltaX: Long);
        {-}
      function  DrawRgnOrBlock: Bool;
        {-}
      function  HasToDraw: Bool;
        {-}
      function  NearestColor(C: TColor): TColor;
        {-}
      procedure Lock;
        {-}
      procedure Unlock;
        {-}
      procedure MoveWindowOrg(const aDelta: Tl3Point);
        overload;
        {-}
      procedure MoveWindowOrg(const aDelta: Tl3SPoint);
        overload;
        {-}
      function  TextMetrics: PTextMetric;
        {-}
      procedure TabbedTextOut(const P: Tl3Point;
                              const R: Tl3Rect;
                              const S: Tl3PCharLenPrim;
                              const aTabStops: Il3TabStops);
        overload;
        {-}
      procedure TabbedTextOut(const P: Tl3SPoint;
                              const R: Tl3SRect;
                              const S: Tl3PCharLenPrim;
                              const aTabStops: Il3TabStops);
        overload;
        {-}
      procedure TabbedMultilineTextOut(const aSt    : Tl3PCharLenPrim;
                                       const Tabs   : Il3TabStops;
                                       var Rect     : Tl3Rect;
                                       Precalculate : Boolean;
                                       aGap         : Integer);
        {-}
      procedure DrawFocusRect(const aRect: Tl3SRect);
        {-}
    public
    // public properties
      property NotFocused: Bool
        read f_NotFocused
        write f_NotFocused;
        {-}
      property DCFlag: TevDCFlag
        read f_DCFlag;
        {-}
      property etoFlags: Word
        read pm_GetetoFlags
        write f_etoFlags
        default eto_Opaque{ + eto_Clipped};
        {-}
      property Invert: Bool
        read pm_GetInvert;
        {-}
      property Drawing: Bool
        read pm_GetDrawing;
        {-}
      property Canvas: TCanvas
        read pm_GetCanvas
        write pm_SetCanvas;
        {-}
      property FrameLines: Il3FrameLines
        read pm_GetFrameLines;
        {* - Парень, ответственный за выравниваение и отрисовку линий. }
      property Painter: Il3HAFPainter
        read f_Painter
        write f_Painter;
        {-}
      property BackColor: TColor
        read pm_GetBackColor
        write pm_SetBackColor
        default def_PaperColor;
        {-}
      property Printed: Bool
        read pm_GetPrinted
        write pm_SetPrinted;
        {-}
      property ShowCursor: Bool
        read pm_GetShowCursor
        write pm_SetShowCursor;
        {-}
      property DrawEnabled: Bool
        read pm_GetDrawEnabled
        write pm_SetDrawEnabled;
        {-}
      property Font: Il3Font
        read Get_Font
        write Set_Font;
        {-}
      property Brush: TBrush
        read pm_GetBrush
        write pm_SetBrush;
        {-}
      property Pen : TPen
        read pm_GetPen
        write pm_SetPen;
        {-}
      property TextColor: TColor
        read pm_GetTextColor
        write pm_SetTextColor
        default clBlack;
        {-}
      property FontIndexSet: Tl3FontIndexes
        read pm_GetFontIndexSet
        write pm_SetFontIndexSet
        default [];
        {-}
      property FontIndex: Tl3FontIndex
        read Get_Index
        write pm_SetFontIndex;
        {-}
      property PageNumber: Long
        read pm_GetPageNumber;
        {-}
      property PageWidthNumber: Long
        read pm_GetPageWidthNumber;
        {-}
      property PageSetup: Il3PageSetup
        read pm_GetPageSetup;
        {-}
      property PageOrientation: Tl3PageOrientation
        read pm_GetPageOrientation
        write pm_SetPageOrientation;
        {-}
      property SectionExtent: Tl3Point
        read pm_GetSectionExtent
        write pm_SetSectionExtent;
        {-}
      property DC: hDC
        read pm_GetDC;
        {-}
      property Owner: TObject
        read f_Owner{GetOwner};
        {-}
    public
    // public events
      property OnDrawSpecialChange: TNotifyEvent
        read f_OnDrawSpecialChange
        write f_OnDrawSpecialChange;
        {-изменение свойства - показывать или нет спецсимволы}
    public
    // public properties
      property DrawSpecial: Bool
        read pm_GetDrawSpecial
        write pm_SetDrawSpecial
        default false;
        {-}
      property Zoom: Long
        read f_Zoom
        write pm_SetZoom
        default def_Zoom;
        {-}
  end;//Tl3Canvas

Комментариев нет:

Отправить комментарий