home *** CD-ROM | disk | FTP | other *** search
- unit UFlexCelGrid;
-
- //Comment / uncomment the $DEFINE USPNGLIB to use Png support
- {$IFDEF WIN32}
- {$DEFINE USEPNGLIB}
- {$ENDIF}
-
- interface
- uses
- {$IFDEF WIN32}
- Windows, Graphics, Grids, JPEG, Messages,
- {$IFDEF USEPNGLIB}
- //////////////////////////////// IMPORTANT ///////////////////////////////////////
- //To be able to display PNG images and WMFs, you have to install TPNGImage from http://pngdelphi.sourceforge.net/
- //If you don't want to install it, delete the "{$DEFINE USEPNGLIB}" at the top of this file
- //Note that this is only needed on Windows, CLX has native support for PNG
- ///////////////////////////////////////////////////////////////////////////////////
- pngimage, pngzlib, dialogs,
- ///////////////////////////////////////////////////////////////////////////////////
- //If you are getting an error here, please read the note above.
- ///////////////////////////////////////////////////////////////////////////////////
- {$ENDIF}
- {$ENDIF}
- {$IFDEF LINUX}
- Qt, QGraphics, QGrids, Types, QControls,
- {$ENDIF}
- {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants, {$IFEND}{$ENDIF} //Delphi 6 or above
-
- SysUtils, Classes, UExcelAdapter, UFlexCelImport, Contnrs,
- UFlxFormats, UFlxMessages, Math, UFlxNumberFormat;
-
- const
- {$IFDEF WIN32}
- AL_LEFT=DT_LEFT;
- AL_BOTTOM=DT_BOTTOM;
- AL_CENTER=DT_CENTER;
- AL_RIGHT=DT_RIGHT;
- AL_TOP=DT_TOP;
- AL_VCENTER=DT_VCENTER;
- {$ENDIF}
- {$IFDEF LINUX}
- AL_LEFT=integer(AlignmentFlags_AlignLeft);
- AL_BOTTOM=integer(AlignmentFlags_AlignBottom);
- AL_CENTER=integer(AlignmentFlags_AlignHCenter);
- AL_RIGHT=integer(AlignmentFlags_AlignRight);
- AL_TOP=integer(AlignmentFlags_AlignTop);
- AL_VCENTER=integer(AlignmentFlags_AlignVCenter);
- {$ENDIF}
-
- type
- TFlexCelGrid=class;
-
- TFlxInPlaceEdit=class(TInPlaceEdit)
- public
- property Font;
- end;
-
- TOnGetFontNameEvent=procedure(Sender: TObject; var FontName: TFontName) of object;
- TOnFormatPictureEvent=procedure(Sender: TObject; const InData: TStream;const PicType: TXlsImgTypes; const OutPicture: TPicture) of object;
- TWideSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: Widestring) of object;
- TOnAllowEditCellEvent = procedure (Sender: TObject; ACol, ARow: Longint; var AllowEdit: boolean) of object;
-
- TPictureData= class
- Col1,Row1,Dx1, DY1, Width, Height: integer;
- IsRectangular: boolean;
- Data: TPicture;
- constructor Create;
- destructor Destroy; override;
- end;
-
- TPictureDataList= class(TObjectList)
- {$INCLUDE TPictureDataListHdr.inc}
- end;
-
- TFlexCelGrid = class(TCustomGrid)
- private
- FFlexCelImport: TFlexCelImport;
- FFormulaReadOnly: boolean;
- FFullWorksheet: boolean;
- FReadOnly: boolean;
- FHideCursor: boolean;
-
- FDrawGridLines: boolean;
- SheetLoaded: boolean;
-
- InPlaceFont: TFont;
-
- LastRow, LastCol: integer;
- FZoom: integer;
- Zoom100: extended;
- UpdatingGridSize: boolean;
-
- PaintClipRect:TRect;
-
- FOnGetFontName: TOnGetFontNameEvent;
- FOnFormatPicture: TOnFormatPictureEvent;
- FOnSelectCell: TSelectCellEvent;
-
- PictureDataList:TPictureDataList;
- FOnSetEditText: TWideSetEditEvent;
- FOnAllowEditCell: TOnAllowEditCellEvent;
-
- procedure SetFlexCelImport(const Value: TFlexCelImport);
- function ColTitle(const i:integer):string;
- function IsEmptyCell(const ARow, ACol: integer): boolean;
- procedure MyDrawCell(ACol, ARow: Integer; ClipRect, CellRect: TRect; AState: TGridDrawState; const First: boolean; const CanSpawnL, CanSpawnR: boolean; const RightCol, BottomRow: integer);
- procedure SetReadOnly(const Value: boolean);
- procedure SetZoom(const Value: integer);
- procedure ResizeRowsAndCols;
-
- procedure WriteText(const Rect: TRect; const X,Y: integer; const OutText: Widestring);
- procedure WrapText(Rect: TRect; const OutText: Widestring; const HAlign, VAlign: Cardinal; const AutoFit: boolean);
- function CalcTextExtent(const OutText: Widestring): TSize;
-
- function CalcAcumRowHeightZoom100(const R1, R2: integer): integer;
- function CalcAcumColWidthZoom100(const C1, C2: integer): integer;
- function CalcAcumRowHeight(const R1, R2: integer): integer;
- function CalcAcumColWidth(const C1, C2: integer): integer;
-
- function CalcPictureRect(const i: integer; const DrawInfo: TGridDrawInfo; var R1: TRect; const All: boolean): boolean;
- procedure ResetClipRgn;
- procedure SetClipRect(const aRect: TRect);
-
- function GetColor(const index: integer): TColor;
- function CellCanSpawnLeft(const aRow, aCol: integer): boolean;
- function CellCanSpawnRight(const aRow, aCol: integer): boolean;
- { Private declarations }
- protected
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
- function SelectCell(ACol, ARow: Longint): Boolean; override;
-
- procedure SizeChanged(OldColCount, OldRowCount: Longint); override;
-
- function CreateEditor: TInplaceEdit; override;
-
-
- {$IFDEF WIN32}
- procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
-
- function GetEditText(ACol, ARow: Longint): string; override;
- procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
- {$ENDIF}
- {$IFDEF LINUX}
- function GetEditText(ACol, ARow: Longint): widestring; override;
- procedure SetEditText(ACol, ARow: Longint; const Value: widestring); override;
- {$ENDIF}
-
- function CanEditShow: Boolean; override;
-
- procedure ColWidthsChanged; override;
- procedure RowHeightsChanged; override;
-
- procedure KeyDown(var Key: Word; Shift: TShiftState); override;
-
- procedure Paint; override;
- procedure Loaded; override;
- { Protected declarations }
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure LoadSheet;
- procedure ApplySheet;
-
- property Row;
- property Col;
- property CanEdit: boolean read CanEditShow;
-
- {$IFDEF WIN32}
- function BorderSize: integer;
- {$ENDIF}
-
- procedure SetCell(const aRow, aCol: integer; const Text: widestring);
- { Public declarations }
- published
- property FlexCelImport: TFlexCelImport read FFlexCelImport write SetFlexCelImport;
- property ReadOnly: boolean read FReadOnly write SetReadOnly;
- property HideCursor: boolean read FHideCursor write FHideCursor;
- property FormulaReadOnly: boolean read FFormulaReadOnly write FFormulaReadOnly;
- property FullWorksheet: boolean read FFullWorksheet write FFullWorksheet;
-
- property Zoom: integer read FZoom write SetZoom default 100;
-
- property Align;
- property Anchors;
- property Enabled;
- property Font;
- property Color;
- property FixedColor;
- property ParentFont;
- property ParentColor;
- property PopupMenu;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
-
- property BorderStyle;
-
- property OnClick;
- property OnContextPopup;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheelDown;
- property OnMouseWheelUp;
- property OnStartDrag;
-
- //EVENTS
- property OnSelectCell: TSelectCellEvent read FOnSelectCell write FOnSelectCell;
- property OnSetEditText: TWideSetEditEvent read FOnSetEditText write FOnSetEditText;
- property OnGetFontName: TOnGetFontNameEvent read FOnGetFontName write FOnGetFontName;
- property OnFormatPicture: TOnFormatPictureEvent read FOnFormatPicture write FOnFormatPicture;
- property OnAllowEditCell: TOnAllowEditCellEvent read FOnAllowEditCell write FOnAllowEditCell;
- { Published declarations }
- end;
-
- procedure Register;
-
- implementation
- {$INCLUDE TPictureDataListImp.inc}
-
- {$R IFlexCelGrid.res}
- procedure Register;
- begin
- RegisterComponents('FlexCel', [TFlexCelGrid]);
- end;
-
- { TFlexCelGrid }
-
- procedure TFlexCelGrid.ApplySheet;
- var
- i: integer;
- begin
- //Cancel editor
- DoExit;
- //We only modify rows wich have changed size, so we don't loose autofit.
- //Rows in excel by default adapt to the font size. If you manually set the row height to a value, you loose that behaviour
- //We should call AutoRowHeight to restore it.
- if Assigned(FlexCelImport)and(FlexCelImport.IsLoaded)and(SheetLoaded) then
- begin
- for i:=1 to RowCount-1 do if RowHeights[i]<> Round(FlexCelImport.RowHeight[i]/RowMult*Zoom100) then
- FlexCelImport.RowHeight[i]:=Round(RowHeights[i]*RowMult/Zoom100);
-
- for i:=1 to ColCount-1 do if ColWidths[i]<> Round(FlexCelImport.ColumnWidth[i]/ColMult*Zoom100) then
- FlexCelImport.ColumnWidth[i]:=Round(ColWidths[i]*ColMult/Zoom100);
- end;
- end;
-
- function TFlexCelGrid.CanEditShow: Boolean;
- begin
- if not Assigned(FFlexCelImport) or not FFlexCelImport.IsLoaded or FReadOnly
- or (FFormulaReadOnly and FlexCelImport.IsFormula[Row, Col])
- or (FlexCelImport.CellMergedBounds[Row, Col].Top<>Row)
- or (FlexCelImport.CellMergedBounds[Row, Col].Left<>Col) then
- Result:=False
- else
- begin
- Result:= inherited CanEditShow;
- if Assigned(OnAllowEditCell) then OnAllowEditCell(Self, Col, Row, Result);
- end;
-
- end;
-
- function TFlexCelGrid.ColTitle(const i: integer): string;
- const
- Z=ord('Z');
- A=ord('A');
- begin
- if i<=Z-A+1 then Result:= chr(A+i-1) else
- Result:= chr(A+(i-1) div (Z-A+1)-1)+chr(A+ (i-1) mod (Z-A+1));
- end;
-
- function TFlexCelGrid.CalcAcumRowHeight(const R1, R2: integer): integer;
- var
- i: integer;
- begin
- Result:=0;
- for i:=R1 to R2-1 do Inc(Result, RowHeights[i]);
- for i:=R1-1 downto R2 do Dec(Result, RowHeights[i]);
- end;
-
- function TFlexCelGrid.CalcAcumRowHeightZoom100(const R1, R2: integer): integer;
- var
- i: integer;
- begin
- Result:=0;
- for i:=R1 to R2-1 do Inc(Result, FlexCelImport.RowHeight[i]);
- for i:=R1-1 downto R2 do Dec(Result, FlexCelImport.RowHeight[i]);
- Result:=Round(Result/RowMult);
- end;
-
- function TFlexCelGrid.CalcAcumColWidth(const C1, C2: integer): integer;
- var
- i: integer;
- begin
- Result:=0;
- for i:=C1 to C2-1 do Inc(Result, ColWidths[i]);
- for i:=C1-1 downto C2 do Dec(Result, ColWidths[i]);
- end;
-
- function TFlexCelGrid.CalcAcumColWidthZoom100(const C1, C2: integer): integer;
- var
- i: integer;
- begin
- Result:=0;
- for i:=C1 to C2-1 do Inc(Result, FlexCelImport.ColumnWidth[i]);
- for i:=C1-1 downto C2 do Dec(Result, FlexCelImport.ColumnWidth[i]);
- Result:=Round(Result/ColMult);
- end;
-
- procedure TFlexCelGrid.ColWidthsChanged;
- begin
- if UpdatingGridsize then exit;
- inherited;
- ApplySheet;
- end;
-
- constructor TFlexCelGrid.Create(AOwner: TComponent);
- begin
- inherited;
- Font.Name:='Arial';
- DefaultDrawing:=False;
- Options := [goRowSizing, goColSizing, goEditing, goThumbTracking];
- LastRow:=-1;
- LastCol:=-1;
- FZoom:=100;
- Zoom100:=1;
- UpdatingGridsize:=false;
- FDrawGridLines:=true;
- PictureDataList:=TPictureDataList.Create;
- SheetLoaded:=false;
- end;
-
- destructor TFlexCelGrid.Destroy;
- begin
- FreeAndNil(PictureDataList);
- inherited;
- end;
-
- function TFlexCelGrid.IsEmptyCell(const ARow, ACol: integer): boolean;
- var
- v: variant;
- begin
- if (aRow<=0) or (aCol<=0) or (ACol>=ColCount)or (ARow>=RowCount) then Result:=false
- else if not FlexCelImport.IsLoaded then Result:= true
- else
- begin
- v:=FlexCelImport.CellValue[aRow, aCol];
- Result:=VarIsEmpty(v)or VarIsNull(v) or ((VarType(v)=vtString) and (v=''));
- end;
- end;
-
- function Intersect(const Rect1, Rect2: TRect; var OutRect: TRect): boolean;
- begin
- OutRect.Left:=Max(Rect1.Left, Rect2.Left);
- OutRect.Top:=Max(Rect1.Top, Rect2.Top);
- OutRect.Right:=Min(Rect1.Right, Rect2.Right);
- OutRect.Bottom:=Min(Rect1.Bottom, Rect2.Bottom);
- Result:=(OutRect.Left<OutRect.Right)and(OutRect.Top<OutRect.Bottom);
- end;
-
- procedure TFlexCelGrid.WriteText(const Rect: TRect; const X,Y: integer; const OutText: Widestring);
- {$IFDEF WIN32}
- var
- Options: Longint;
- {$ENDIF}
-
- begin
- {$IFDEF LINUX} //Linux canvas has support for widestrings
- Canvas.TextRect(Rect, X, Y, OutText);
- {$ENDIF}
- {$IFDEF WIN32} //If we use Canvas.textrect we loose widestrings
- Options := ETO_CLIPPED or Canvas.TextFlags or ETO_OPAQUE;
- Windows.ExtTextOutW(Canvas.Handle, X, Y, Options, @Rect, PWideChar(OutText),
- Length(OutText), nil);
- {$ENDIF}
-
- end;
-
- procedure TFlexCelGrid.WrapText(Rect: TRect; const OutText: Widestring; const HAlign, VAlign: Cardinal; const AutoFit: boolean);
- var
- Options: Int64; //So it works in linux and windows
-
- begin
- {$IFDEF LINUX}
- Options:=HAlign+VAlign;
- if AutoFit then Options:=Options+integer(AlignmentFlags_WordBreak) else Options:=Options+integer(AlignmentFlags_SingleLine);
- Canvas.TextRect(Rect, Rect.Left , Rect.Top , OutText, Options);
- {$ENDIF}
- {$IFDEF WIN32}
- Options:=HAlign+VAlign ;
- if AutoFit then Options:=Options+DT_WORDBREAK else Options:=Options+DT_SINGLELINE;
- InflateRect(Rect, -1, -1);
- Windows.DrawTextW(Canvas.Handle, PWideChar(OutText), Length(OutText), Rect, Options);
- {$ENDIF}
-
- end;
-
- function TFlexCelGrid.CalcTextExtent(const OutText: Widestring): TSize;
- begin
- {$IFDEF LINUX} //Linux canvas has support for widestrings
- Result:=Canvas.TextExtent(OutText);
- {$ENDIF}
- {$IFDEF WIN32} //If we use Canvas.textrect we loose widestrings
- GetTextExtentPoint32W(Canvas.Handle, PWideChar(OutText), Length(OutText), Result);
- {$ENDIF}
- end;
-
- function TFlexCelGrid.GetColor(const index: integer): TColor;
- begin
- if (Index>0) and (Index<=FlexCelImport.ColorPaletteCount) then
- Result:=FlexCelImport.ColorPalette[Index]
- else Result:=clBlack;
- end;
-
- function TFlexCelGrid.CellCanSpawnRight(const aRow, aCol: integer): boolean;
- var
- Fm: TFlxFormat;
- Mb: TXlsCellRange;
- begin
- Result:=False;
- Fm:=FFlexCelImport.CellFormatDef[aRow, aCol];
- if (Fm.HAlignment= fha_Right) or (Fm.WrapText) then exit;
- Mb:=FFlexCelImport.CellMergedBounds[aRow, aCol];
- Result:= (Mb.Left=aCol) and (Mb.Right= aCol) and (Mb.Top=aRow) and (Mb.Bottom=aRow);
- end;
-
- function TFlexCelGrid.CellCanSpawnLeft(const aRow, aCol: integer): boolean;
- var
- Fm: TFlxFormat;
- Mb: TXlsCellRange;
- begin
- Result:=False;
- Fm:=FFlexCelImport.CellFormatDef[aRow, aCol];
- if (Fm.HAlignment= fha_Left) or (Fm.WrapText) then exit;
- Mb:=FFlexCelImport.CellMergedBounds[aRow, aCol];
- Result:= (Mb.Left=aCol) and (Mb.Right= aCol) and (Mb.Top=aRow) and (Mb.Bottom=aRow);
- end;
-
- procedure TFlexCelGrid.MyDrawCell(ACol, ARow: Integer; ClipRect, CellRect: TRect; AState: TGridDrawState; const First: boolean; const CanSpawnL, CanSpawnR: boolean; const RightCol, BottomRow: integer);
- var
- ColorIndex: integer;
- Fm, Fm1: TFlxFormat;
- HAlign, VAlign: Cardinal;
- TextRect, FinalRect: TRect;
- OutValue: variant;
- OutText: widestring;
- i, k: integer;
- X, Y, Clp: integer;
- FontName: TFontName;
- TextExtent: TSize;
- BottomColor, RightColor: TColor;
- Dg, DBottom, DRight: boolean;
- Corner: byte;
- FontColor: integer;
- MergedBounds: TXlsCellRange;
- MultiLine: boolean;
- begin
- if FZoom<=50 then Clp:=0 else if FZoom<=90 then Clp:=1 else Clp:=2; //Do not use margins around the cell if zoom is small
- MultiLine:=false;
- //Reset Style
- Canvas.Font:=Font;
- Canvas.Font.Size:=Round(Canvas.Font.Size*Zoom100);
- BottomColor:=clLtGray;
- RightColor:=clLtGray;
- DBottom:=false; DRight:=false;
-
- if First then
- begin
- Canvas.Brush.Color:=Color;
- Canvas.Pen.Width:=1;
- end;
-
-
- HAlign:=AL_LEFT;
- VAlign:=AL_BOTTOM;
- OutText:='';
-
- if not Assigned(FlexCelImport) then exit;
-
- if FlexCelImport.IsLoaded and (aRow>0) and (aCol>0) then
- begin
- //MERGED CELLS
- //We see this before anything else, because if it's merged, we have to exit
- MergedBounds:= FFlexCelImport.CellMergedBounds[aRow, aCol];
- if aCol < MergedBounds.Right then CellRect.Right:=CellRect.Left+CalcAcumColWidth(aCol, MergedBounds.Right+1);
- if aRow < MergedBounds.Bottom then CellRect.Bottom:=CellRect.Top+CalcAcumRowHeight(aRow, MergedBounds.Bottom+1);
-
- if (aCol > MergedBounds.Left) or (aRow > MergedBounds.Top) then
- begin
- MyDrawCell(MergedBounds.Left, MergedBounds.Top, ClipRect,
- Rect(ClipRect.Left+CalcAcumColWidth(aCol, MergedBounds.Left),
- ClipRect.Top+CalcAcumRowHeight(aRow, MergedBounds.Top),
- ClipRect.Left+CalcAcumColWidth(aCol, MergedBounds.Left+1), //This is TopLeft cell
- ClipRect.Top+CalcAcumRowHeight(aRow, MergedBounds.Top+1)),
- AState, True, False, False, MergedBounds.Right, MergedBounds.Bottom);
- exit;
- end;
-
- //Value
- OutValue:=FlexCelImport.CellValue[aRow, aCol];
- if VarType(OutValue)=VarBoolean then HAlign:=AL_CENTER else
- if (VarType(OutValue)<>VarOleStr)and(VarType(OutValue)<>VarString) then HAlign:=AL_RIGHT;
-
- Fm:=FlexCelImport.CellFormatDef[aRow, aCol];
- //MULTILINE
- MultiLine:=Fm.WrapText;
- //PATTERN
- if First then
- begin
- ColorIndex:=Fm.FillPattern.fgColorIndex;
- if (ColorIndex>0)and(ColorIndex<=56) then
- begin
- Canvas.Brush.Color:= FlexCelImport.ColorPalette[ColorIndex];
- BottomColor:=Canvas.Brush.Color;
- RightColor:=BottomColor;
- DBottom:=true; DRight:=true;
- end;
- end;
- //FONT
- if (Fm.Font.ColorIndex>0)and (integer(Fm.Font.ColorIndex)<FlexCelImport.ColorPaletteCount) then
- Canvas.Font.Color:=FlexCelImport.ColorPalette[Fm.Font.ColorIndex];
-
- FontName:=Fm.Font.Name;
- if Assigned(OnGetFontName) then OnGetFontName(Self, FontName);
- Canvas.Font.Name:=FontName;
- Canvas.Font.Size:=Round(Fm.Font.Size20 / 20 * Zoom100);
- if Fm.Font.Underline <> fu_None then
- Canvas.Font.Style:=Canvas.Font.Style+[fsUnderline];
-
- if flsBold in Fm.Font.Style then Canvas.Font.Style:=Canvas.Font.Style+[fsBold];
- if flsItalic in Fm.Font.Style then Canvas.Font.Style:=Canvas.Font.Style+[fsItalic];
- if flsStrikeOut in Fm.Font.Style then Canvas.Font.Style:=Canvas.Font.Style+[fsStrikeOut];
- //BORDERS
- if (RightCol<>ACol)or (BottomRow<>aRow) then
- Fm1:=FlexCelImport.CellFormatDef[BottomRow, RightCol]
- else
- Fm1:=Fm;
-
- if Fm1.Borders.Bottom.Style <> fbs_None then
- begin
- BottomColor:=GetColor(Fm1.Borders.Bottom.ColorIndex);
- DBottom:=true;
- end;
- if Fm1.Borders.Right.Style <> fbs_None then
- begin
- RightColor:=GetColor(Fm1.Borders.Bottom.ColorIndex);
- DRight:=true;
- end;
- //Search for the other 2 borders
- if RightCol<ColCount-1 then
- begin
- Fm1:=FlexCelImport.CellFormatDef[BottomRow, RightCol+1];
- if Fm1.Borders.Left.Style <> fbs_None then
- begin
- RightColor:=GetColor(Fm1.Borders.Left.ColorIndex);
- DRight:=true;
- end;
- end;
- if BottomRow<RowCount-1 then
- begin
- Fm1:=FlexCelImport.CellFormatDef[BottomRow+1, RightCol];
- if Fm1.Borders.Top.Style <> fbs_None then
- begin
- BottomColor:=GetColor(Fm1.Borders.Top.ColorIndex);
- DBottom:=true;
- end;
- end;
-
- //ALIGN
- case Fm.HAlignment of
- fha_left: HAlign:=AL_LEFT;
- fha_center:HAlign:=AL_CENTER;
- fha_right: HAlign:=AL_RIGHT;
- end;//case
-
- case Fm.VAlignment of
- fva_top: VAlign:=AL_TOP;
- fva_center: VAlign:=AL_VCENTER;
- fva_bottom: VAlign:=AL_BOTTOM ;
- end; //case
-
- //FORMULA
- if FFormulaReadOnly and FlexCelImport.IsFormula[aRow, aCol] then
- Canvas.Brush.Color := clsilver;
-
- if (aRow=Row)and(aCol=Col) then
- if (InPlaceEditor<>nil) then (InplaceEditor as TFlxInPlaceEdit).Font:=Canvas.Font
- else InPlaceFont:=Canvas.Font;
-
- //NUMERIC FORMAT
- FontColor:=Canvas.Font.Color;
- OutText:=XlsFormatValue(OutValue, Fm.Format, FontColor);
- Canvas.Font.Color:=FontColor;
- end;
-
- if FlexCelImport.IsLoaded and (ACol=0)and(ARow>0) and not FlexCelImport.AutoRowHeight[aRow] then
- begin
- Canvas.Font.Style:=Canvas.Font.Style+[fsBold];
- Canvas.Font.Color:=clNavy;
- end;
-
- if (ACol=0)or(ARow=0) then
- begin
- HAlign:=AL_CENTER;
- Canvas.Brush.Color := FixedColor;
- BottomColor:=clGray;
- RightColor:=BottomColor;
- if not HideCursor then
- if (aRow=Row)or (aCol=Col) then Canvas.Brush.Color:= $00F2BEAA;
-
- if (aRow=0) and (aCol<>0) then OutText:=ColTitle(aCol)
- else if aRow<>0 then OutText:=IntToStr(aRow);
- end;
-
- if First then
- begin
- //Draw Grid lines and clear cell
- Canvas.FillRect(ClipRect);
- Dg:=((Zoom>=50) and (FDrawGridLines))or(ARow=0) or (ACol=0);
- Canvas.Pen.Color:=BottomColor;
- if (BottomColor=RightColor)and (Dg or (DBottom and DRight)) then
- Canvas.Polyline([Point(CellRect.Left,CellRect.Bottom-1),
- Point(CellRect.Right-1,CellRect.Bottom-1),
- Point(CellRect.Right-1,CellRect.Top-1)])
- else
- begin
- if DBottom then Corner:=0 else Corner:=1;
- if Dg or DBottom then
- Canvas.Polyline([Point(CellRect.Left-1+Corner,CellRect.Bottom-1),
- Point(CellRect.Right-Corner,CellRect.Bottom-1)]);
- Canvas.Pen.Color:=RightColor;
- if DRight then Corner:=0 else Corner:=1;
- if Dg or DRight then
- Canvas.Polyline([Point(CellRect.Right-1,CellRect.Bottom-1-Corner),
- Point(CellRect.Right-1,CellRect.Top-1+Corner)]);
- end;
- end;
-
- //Support for drawing a continued cell on an empty one
- if IsEmptyCell(ARow, ACol) and FFlexCelImport.IsLoaded and not (EditorMode)then
- begin
- if Zoom<=25 then exit; //Optimize for small zoom
- //Search for the previous non empty cell
- i:=FFlexCelImport.ColIndex[aRow,aCol]-1;
- while (i>0)and(IsEmptyCell(aRow,FlexCelImport.ColByIndex[aRow,i])) do dec(i);
- if i>0 then
- begin
- k:=FFlexCelImport.ColByIndex[aRow, i];
- if CellCanSpawnRight(aRow, k) then
- MyDrawCell(k, ARow, ClipRect, Rect(CellRect.Left+CalcAcumColWidth(aCol,k), CellRect.Top, CellRect.Left+CalcAcumColWidth(aCol,k+1), CellRect.Bottom), AState, False, True, IsEmptyCell(aRow, aCol+1), k, ARow);
- end;
- //Search for next non empty cell
- i:=FFlexCelImport.ColIndex[aRow,aCol];
- while (i>0) and(i<=FFlexCelImport.ColIndexCount[aRow])and(IsEmptyCell(aRow,FlexCelImport.ColByIndex[aRow,i])) do inc(i);
- if (i>0)and(i<=FFlexCelImport.ColIndexCount[aRow]) then
- begin
- k:=FFlexCelImport.ColByIndex[aRow, i];
- if CellCanSpawnLeft(aRow, k) then
- MyDrawCell(k, ARow, ClipRect, Rect(CellRect.Left+CalcAcumColWidth(aCol,k), CellRect.Top, CellRect.Left+CalcAcumColWidth(aCol,k+1), CellRect.Bottom), AState,False, IsEmptyCell(aRow, aCol-1), True, k, ARow);
- end;
-
- exit; //nothing to draw
- end;
-
- TextRect:=Classes.Rect(ClipRect.Left+Clp, ClipRect.Top+Clp, ClipRect.Right-Clp, ClipRect.Bottom-Clp);
- TextExtent:=CalcTextExtent(OutText);
-
- case VAlign of
- AL_TOP: Y:=CellRect.Top+Clp;
- AL_VCENTER: Y:=(CellRect.Top+CellRect.Bottom-TextExtent.cy) div 2;
- else Y:=CellRect.Bottom-Clp-TextExtent.cy;
- end; //case
-
- case HAlign of
- AL_RIGHT: X:=CellRect.Right-Clp-TextExtent.cx;
- AL_CENTER: X:=(CellRect.Left+CellRect.Right-TextExtent.cx) div 2;
- else X:=CellRect.Left+Clp;
- end; //case
-
- FinalRect:=ClipRect;
- if FinalRect.Right>ClientWidth+BorderSize then FinalRect.Right:=ClientWidth+BorderSize; //This is for kylix not writing past the scrollbar
- SetClipRect(FinalRect);
-
- //Clear grid lines if spawning the cell
- if First then
- begin
- //If it's a merged cell, draw on all the cell
- if (CellRect.Top<>ClipRect.Top) or (CellRect.Left<>ClipRect.Left)
- or (CellRect.Bottom<>ClipRect.Bottom) or (CellRect.Right<>ClipRect.Right) then
- begin
- inc(TextRect.Right,Clp);
- dec(TextRect.Left,Clp);
- end
- else
- if not MultiLine then
- begin
- if IsEmptyCell(aRow, aCol+1) then
- begin
- inc(TextRect.Right,Clp);
- if (X+TextExtent.cx>= TextRect.Right) and (X<TextRect.Right) then //Clear right grid line
- Canvas.FillRect(Rect(ClipRect.Right-1,ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom-1))
- end;
- if IsEmptyCell(aRow, aCol-1) then
- begin
- dec(TextRect.Left,Clp);
- end;
- end;
- end else
- begin
- if CanSpawnL then dec(TextRect.Left,Clp);
- if CanSpawnR then inc(TextRect.Right,Clp);
-
- if CanSpawnR and (X+TextExtent.cx>= TextRect.Right) and (X<TextRect.Right) then //Clear right grid line
- Canvas.FillRect(Rect(ClipRect.Right-1,ClipRect.Top, ClipRect.Right+1, ClipRect.Bottom-1))
- end;
-
- if MultiLine or
- First and
- ( (CellRect.Top<>ClipRect.Top) or (CellRect.Left<>ClipRect.Left) //Merged Cell
- or (CellRect.Bottom<>ClipRect.Bottom) or (CellRect.Right<>ClipRect.Right)
- ) then
- WrapText(CellRect, OutText, HAlign, VAlign, MultiLine)
- else
- if Intersect(TextRect, Rect(X,Y,X+TextExtent.cx,Y+TextExtent.cy), FinalRect) then
- WriteText(FinalRect, X, Y, OutText);
-
- ResetClipRgn;
- end;
-
- {$IFDEF WIN32}
- function TFlexCelGrid.GetEditText(ACol, ARow: Integer): string;
- begin
- if not Assigned(FFlexCelImport) or not FFlexCelImport.IsLoaded then Result:='' else
- Result:=FFlexCelImport.CellValue[ARow, ACol];
- end;
- {$ENDIF}
- {$IFDEF LINUX}
- function TFlexCelGrid.GetEditText(ACol, ARow: Integer): widestring;
- begin
- if not Assigned(FFlexCelImport) or not FFlexCelImport.IsLoaded then Result:='' else
- Result:=FFlexCelImport.CellValue[ARow, ACol];
- end;
- {$ENDIF}
-
- procedure TFlexCelGrid.Loaded;
- begin
- inherited;
- DefaultColWidth:=220;
- DefaultRowHeight:=16;
- ColWidths[0]:=48;
- end;
-
- procedure TFlexCelGrid.ResizeRowsAndCols;
- var
- i:integer;
- begin
- UpdatingGridsize:=true;
- try
- DefaultRowHeight:=Round(FlexCelImport.DefaultRowHeight/RowMult*Zoom100);
- for i:=1 to Min(RowCount-1, FlexCelImport.MaxRow) do
- if not(FlexCelImport.IsEmptyRow(i)) then RowHeights[i]:= Round(FlexCelImport.RowHeight[i]/RowMult*Zoom100);
-
- DefaultColWidth:=Round(FlexCelImport.DefaultColWidth/ColMult*Zoom100);
- for i:=1 to ColCount-1 do ColWidths[i]:= Round(FlexCelImport.ColumnWidth[i]/ColMult*Zoom100);
- ColWidths[0]:=Round(48*Zoom100);
- finally
- UpdatingGridsize:=false;
- ColWidthsChanged;
- RowHeightsChanged;
- end; //finally
- end;
-
- {$IFDEF USEPNGLIB}
- type
- TSmallRect=packed record
- Left,
- Top,
- Right,
- Bottom: SmallInt;
- end;
-
- //WMF Header
- TMetafileHeader = packed record
- Key: Longint;
- Handle: SmallInt;
- Rect: TSmallRect;
-
- Inch: Word;
- Reserved: Longint;
- CheckSum: Word;
- end;
-
- function ComputeAldusChecksum(var WMF: TMetafileHeader): Word;
- type
- PWord = ^Word;
- var
- pW: PWord;
- pEnd: PWord;
- begin
- Result := 0;
- pW := @WMF;
- pEnd := @WMF.CheckSum;
- while Longint(pW) < Longint(pEnd) do
- begin
- Result := Result xor pW^;
- Inc(Longint(pW), SizeOf(Word));
- end;
- end;
-
- procedure LoadWmf(const OutPicture: TPicture; const InStream: TStream; const PicType: TXlsImgTypes);
- const
- Z_OK=0;
- Z_STREAM_END=1;
- var
- WmfHead: TMetafileHeader;
- MemStream, CompressedStream: TMemoryStream;
- ZL: TZStreamRec;
- Buff: Array of char;
- Res, LastOut: integer;
- BoundRect: TRect;
- IsCompressed: byte;
- begin
- MemStream:=TMemoryStream.Create;
- try
- if PicType=xli_wmf then
- begin
- //Write Metafile Header
- FillChar(WmfHead, SizeOf(WmfHead), 0);
- WmfHead.Key:=Integer($9AC6CDD7);
- InStream.Position:=4;
-
- //We can't just read into WmfHead.Rect, beacuse this is small ints, not ints
- InStream.ReadBuffer(BoundRect, SizeOf(BoundRect));
- WmfHead.Rect.Left:=BoundRect.Left;
- WmfHead.Rect.Top:=BoundRect.Top;
- WmfHead.Rect.Right:=BoundRect.Right;
- WmfHead.Rect.Bottom:=BoundRect.Bottom;
-
- WmfHead.Inch:=96;
- WmfHead.CheckSum:=ComputeAldusChecksum(WmfHead);
- MemStream.WriteBuffer(WmfHead, SizeOf(WmfHead));
- end;
-
- InStream.Position:=32;
- InStream.Read(IsCompressed, SizeOf(IsCompressed));
- InStream.Position:=34;
-
- if IsCompressed=0 then //Data is compressed
- begin
- //Uncompress Data
- Fillchar(ZL, SIZEOF(TZStreamRec), #0);
-
- CompressedStream:=TMemoryStream.Create;
- try
- CompressedStream.CopyFrom(InStream, InStream.Size- InStream.Position);
- CompressedStream.Position:=0;
- FillChar(Zl, SizeOf(Zl), #0);
- Zl.next_in:=CompressedStream.Memory;
- Zl.avail_in:=CompressedStream.Size;
- SetLength(Buff, 2048); //Arbitrary block size
- Zl.next_out:=@Buff[0];
- Zl.avail_out:=Length(Buff);
- LastOut:=0;
- try
- if InflateInit_(ZL, zlib_version, SIZEOF(TZStreamRec))<> Z_OK then
- raise Exception.Create(ErrInvalidWmf);
- repeat
- Res:=Inflate(ZL,0);
- if (Res<> Z_OK) and (Res<>Z_STREAM_END) then
- raise Exception.Create(ErrInvalidWmf);
-
- MemStream.WriteBuffer(Buff[0], Zl.Total_Out-LastOut);
- LastOut:=Zl.Total_Out;
- Zl.next_out:=@Buff[0];
- Zl.avail_out:=Length(Buff);
- until Res= Z_STREAM_END;
- finally
- InflateEnd(ZL);
- end; //Finally
- finally
- FreeAndNil(CompressedStream);
- end;
- end else
- begin
- MemStream.CopyFrom(InStream, InStream.Size-InStream.Position);
- end;
-
- MemStream.Position:=0;
- OutPicture.Graphic.LoadFromStream(MemStream);
- finally
- FreeAndNil(MemStream);
- end; //Finally
- end;
-
- {$ENDIF}
-
- procedure TFlexCelGrid.LoadSheet;
- var
- i: integer;
- Pic: TStream;
- PicType: TXlsImgTypes;
- Anchor: TClientAnchor;
- PicDat: TPictureData;
- Bmp:TBitmap;
- {$IFDEF WIN32}
- Jpeg: TJpegImage;
- {$ENDIF}
- {$IFDEF USEPNGLIB}
- Png: TPNGObject;
- Wmf: TMetafile;
- {$ENDIF}
- begin
- DoExit;
- if not Assigned(FFlexcelImport)or not FFlexCelImport.IsLoaded then exit;
- if not FFlexCelImport.CanOptimizeRead then Raise Exception.Create(ErrUseFasterAdapter);
- if FFullWorksheet then
- begin
- RowCount:= 65536+1;
- ColCount:= 256+1;
- end else
- begin
- if FlexCelImport.MaxRow+1 >2 then RowCount:=FlexCelImport.MaxRow+1 else RowCount:=2;
- if FlexCelImport.MaxCol+1 >2 then ColCount:=FlexCelImport.MaxCol+1 else ColCount:=2;
- end;
- // FixedRows:=3;
- // FixedCols:=2;
- Row:=FixedRows;
- Col:=FixedCols;
- FDrawGridLines:=FlexCelImport.ShowGridLines;
-
- SheetLoaded:=true;
- ResizeRowsAndCols;
-
- PictureDataList.Clear;
- for i:=0 to FlexCelImport.PicturesCount-1 do
- begin
- Pic:=TMemoryStream.Create;
- try
- FlexCelImport.GetPicture(i, Pic, PicType, Anchor);
- PicDat:= TPictureData.Create;
- try
- //We save it this way so image does not get resized when resizing cols or rows
- PicDat.Col1:= Anchor.Col1;
- PicDat.Row1:= Anchor.Row1;
- PicDat.Dx1:=Round(Anchor.Dx1*FlexCelImport.ColumnWidth[Anchor.Col1]/ColMult/1024);
- PicDat.Dy1:=Round(Anchor.Dy1*FlexCelImport.RowHeight[Anchor.Row1]/RowMult/255);
- PicDat.Width:= CalcAcumColWidthZoom100(Anchor.Col1, Anchor.Col2)+Round(Anchor.Dx2*FlexCelImport.ColumnWidth[Anchor.Col2]/ColMult/1024)-PicDat.Dx1;
- PicDat.Height:= CalcAcumRowHeightZoom100(Anchor.Row1, Anchor.Row2)+Round(Anchor.Dy2*FlexCelImport.RowHeight[Anchor.Row2]/RowMult/255)-PicDat.Dy1;
-
- PicDat.IsRectangular:= PicType in [xli_Bmp, xli_Jpeg, xli_Png];
-
- Pic.Position:=0;
- case PicType of
- {$IFDEF WIN32}
- xli_Jpeg:
- begin
- Jpeg:=TJPEGImage.Create;
- try
- PicDat.Data.Graphic:=Jpeg;
- finally
- FreeAndNil(Jpeg); //Remember TPicture.Graphic keeps a COPY of the TGraphic
- end;
- (PicDat.Data.Graphic as TJPEGImage).Performance:=jpBestQuality;
- PicDat.Data.Graphic.LoadFromStream(Pic);
- end;
- xli_Bmp:
- begin
- Bmp:=TBitmap.Create;
- try
- PicDat.Data.Graphic:=Bmp;
- finally
- FreeAndNil(Bmp); //Remember TPicture.Graphic keeps a COPY of the TGraphic
- end;
- PicDat.Data.Graphic.LoadFromStream(Pic);
- end;
- //There is no direct support for PNG, because there is not a standard Delphi class to support it.
- //No direct support for wmf/emf, because it uses zlib and it would have to be added to the package list.
- //To support it define USEPNGLIB at the top of this file
-
- {$IFDEF USEPNGLIB}
- xli_png:
- begin
- Png:=TPNGObject.Create;
- try
- PicDat.Data.Graphic:=Png;
- finally
- FreeAndNil(Png); //Remember TPicture.Graphic keeps a COPY of the TGraphic
- end;
- PicDat.Data.Graphic.LoadFromStream(Pic);
- end;
-
- xli_wmf, xli_emf:
- begin
- Wmf:=TMetaFile.Create;
- try
- PicDat.Data.Graphic:=Wmf;
- finally
- FreeAndNil(Wmf);
- end; //finally
- LoadWmf(PicDat.Data, Pic, PicType);
- end;
- {$ENDIF}
-
- {$ENDIF}
- {$IFDEF LINUX}
- //Here png is directly supported. Not metafiles...
- xli_Bmp, xli_Jpeg, xli_Png:
- begin
- Bmp:=TBitmap.Create;
- try
- PicDat.Data.Graphic:=Bmp;
- finally
- FreeAndNil(Bmp); //Remember TPicture.Graphic keeps a COPY of the TGraphic
- end;
- PicDat.Data.Graphic.LoadFromStream(Pic);
- end;
- {$ENDIF}
-
- else if Assigned (OnFormatPicture) then OnFormatPicture(Self, Pic, PicType, PicDat.Data);
- end; //case
-
- PictureDataList.Add(PicDat);
- except
- FreeAndNil(PicDat);
- //Dont raise... is not a major error;
- end; //finally
- finally
- FreeAndNil(Pic);
- end; //Finally
- end;
- Invalidate;
- end;
-
- procedure TFlexCelGrid.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if Operation = opRemove then
- begin
- if AComponent = FFlexCelImport then
- FFlexCelImport:= nil;
- end;
- end;
-
- function TFlexCelGrid.CalcPictureRect(const i: integer; const DrawInfo: TGridDrawInfo; var R1: TRect;const All: boolean): boolean;
- var
- Row1,Col1, w, h: integer;
- begin
- Result:=false;
- Col1:=PictureDataList[i].Col1; Row1:=PictureDataList[i].Row1;
- if Col1> DrawInfo.Horz.LastFullVisibleCell+1 then exit;
- if Row1> DrawInfo.Vert.LastFullVisibleCell+1 then exit;
- w:=Round(PictureDataList[i].Width*Zoom100)+Round(PictureDataList[i].Dx1*Zoom100); //Separated rounds so we don't have rouding errors
- while (Col1<LeftCol-FixedCols+1)and (w>0) do
- begin
- dec(w, ColWidths[Col1]);
- inc(Col1);
- end;
- if w<=0 then exit;
-
- h:=Round(PictureDataList[i].Height*Zoom100)+Round(PictureDataList[i].Dy1*Zoom100);
- while (Row1<TopRow-FixedRows+1)and (h>0) do
- begin
- dec(h, RowHeights[Row1]);
- inc(Row1);
- end;
- if h<=0 then exit;
-
- if All then
- begin
- R1.Left:=Round(BorderSize+ColWidths[0]+CalcAcumColWidth(LeftCol-FixedCols+1, PictureDataList[i].Col1)+PictureDataList[i].Dx1*Zoom100);
- R1.Top:=Round(BorderSize+RowHeights[0]+CalcAcumRowHeight(TopRow-FixedRows+1, PictureDataList[i].Row1)+PictureDataList[i].Dy1*Zoom100);
- R1.Right:=R1.Left+Round(PictureDataList[i].Width*Zoom100);
- R1.Bottom:=R1.Top+Round(PictureDataList[i].Height*Zoom100);
- end else
- begin
- R1.Left:=Round(BorderSize+ColWidths[0]+CalcAcumColWidth(LeftCol-FixedCols+1, Col1));
- R1.Top:=Round(BorderSize+RowHeights[0]+CalcAcumRowHeight(TopRow-FixedRows+1, Row1));
- R1.Right:=R1.Left+w;
- R1.Bottom:=R1.Top+h;
- if PictureDataList[i].Col1>= LeftCol-FixedCols+1 then inc(R1.Left, Round(PictureDataList[i].Dx1*Zoom100));
- if PictureDataList[i].Row1>= TopRow-FixedRows+1 then inc(R1.Top, Round(PictureDataList[i].Dy1*Zoom100));
- end;
- Result:=true;
- end;
-
- procedure TFlexCelGrid.ResetClipRgn;
- begin
- {$IFDEF WIN32}
- SelectClipRgn(Canvas.Handle,0);
- IntersectClipRect(Canvas.Handle, PaintClipRect.Left, PaintClipRect.Top, PaintClipRect.Right, PaintClipRect.Bottom);
- {$ENDIF}
- {$IFDEF LINUX}
- Canvas.SetClipRect(PaintClipRect);
- {$ENDIF}
- end;
-
- procedure TFlexCelGrid.SetClipRect(const aRect: TRect);
- begin
- {$IFDEF WIN32}
- IntersectClipRect(Canvas.Handle, aRect.Left, aRect.Top, aRect.Right, aRect.Bottom);
- {$ENDIF}
- {$IFDEF LINUX}
- Canvas.SetClipRect(aRect);
- {$ENDIF}
- end;
-
- procedure TFlexCelGrid.Paint;
- var
- FocRect, R1: TRect;
- i: integer;
- DrawInfo: TGridDrawInfo;
- begin
- try
- {$IFDEF WIN32}
- PaintClipRect:=Canvas.ClipRect;
- {$ENDIF}
- {$IFDEF LINUX}
- PaintClipRect:=Rect(BorderSize, BorderSize, BorderSize+ClientWidth, BorderSize+ClientHeight); //QT bug?
- {$ENDIF}
- CalcDrawInfo(DrawInfo);
-
- {$IFDEF WIN32}
- //This is to avoid flicker drawing the image. Only implemented on windows because i can't get it only with TCanvas.SetClipRect
- for i:=0 to PictureDataList.Count-1 do
- if CalcPictureRect(i, DrawInfo, R1, False) and PictureDataList[i].IsRectangular then
- ExcludeClipRect(Canvas.Handle, R1.Left, R1.Top, R1.Right, R1.Bottom);
- {$ENDIF}
-
- inherited;
-
- if (LastCol<>Col)or (LastRow<>Row) then
- begin
- //InvalidateCell(LastRow, LastCol);
- LastRow:=Row;
- LastCol:=Col;
- end;
- Canvas.Pen.Width:=1;
- Canvas.Pen.Color:=clBlack;
- if not (csDesigning in ComponentState) and not HideCursor then
- begin
- FocRect:=CellRect(Col,Row);
- for i:=0 to 1 do
- Canvas.Polyline([Point(FocRect.Left+i, FocRect.Top+i), Point(FocRect.Right-i-1, FocRect.Top+i), Point(FocRect.Right-i-1, FocRect.Bottom-i-1), Point(FocRect.Left+i, FocRect.Bottom-i-1),Point(FocRect.Left+i, FocRect.Top+i)]);
- end;
- if not Assigned(FFlexCelImport) then exit;
-
- ResetClipRgn;
-
- Canvas.Brush.Color:=clWhite; Canvas.Pen.Color:=clBlack;
- SetClipRect(Rect(BorderSize+ColWidths[0], BorderSize+RowHeights[0], BorderSize+ClientWidth, BorderSize+ClientHeight));
- //Draw images
- for i:=0 to PictureDataList.Count-1 do
- if CalcPictureRect(i, DrawInfo, R1, True) then
- begin
- if (PictureDataList[i].Data.Graphic=nil) then Canvas.Rectangle(R1) else
- Canvas.StretchDraw(R1, PictureDataList[i].Data.Graphic);
- end;
-
- ResetClipRgn;
- except
- //No exceptions on paint...
- end;
- end;
-
- procedure TFlexCelGrid.RowHeightsChanged;
- begin
- if not UpdatingGridSize then
- begin
- inherited;
- ApplySheet;
- end;
- end;
-
- function TFlexCelGrid.SelectCell(ACol, ARow: Integer): Boolean;
- begin
- InvalidateCell(0, Row);
- InvalidateCell(Col, 0);
- InvalidateCell(0, ARow);
- InvalidateCell(ACol, 0);
- Result := True;
- if Assigned(FFlexCelImport) and (FFLexCelImport.IsLoaded) and Assigned(FOnSelectCell) then
- FOnSelectCell(Self, ACol, ARow, Result);
- end;
-
- {$IFDEF WIN32}
- procedure TFlexCelGrid.SetEditText(ACol, ARow: Longint; const Value: string);
- var
- w: WideString;
- begin
- SetCell(ARow, ACol, Value);
- w:=Value;
- if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, w);
- end;
- {$ENDIF}
- {$IFDEF LINUX}
- procedure TFlexCelGrid.SetEditText(ACol, ARow: Longint; const Value: widestring);
- begin
- SetCell(ARow, ACol, Value);
- if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, Value);
- end;
- {$ENDIF}
-
- procedure TFlexCelGrid.SetFlexCelImport(const Value: TFlexCelImport);
- begin
- FFlexCelImport := Value;
- Invalidate;
- end;
-
- procedure TFlexCelGrid.SizeChanged(OldColCount, OldRowCount: Integer);
- begin
- end;
-
- procedure TFlexCelGrid.DrawCell(ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
- begin
- MyDrawCell(ACol, ARow, ARect, ARect, AState, True, False, False, ACol, ARow);
- end;
-
- procedure TFlexCelGrid.SetReadOnly(const Value: boolean);
- begin
- FReadOnly := Value;
- if FReadOnly then Options:=Options - [goEditing] else Options:= Options + [goEditing];
- end;
-
- procedure TFlexCelGrid.KeyDown(var Key: Word; Shift: TShiftState);
- begin
- inherited;
- {$IFDEF WIN32}
- if (Key = VK_DELETE) then
- {$ENDIF}
- {$IFDEF LINUX}
- if (Key = KEY_DELETE) then
- {$ENDIF}
-
- begin
- if Assigned(FlexCelImport)and FlexCelImport.IsLoaded then
- FlexCelImport.CellValue[Row,Col]:=unassigned;
- //InvalidateRow(aRow) doesnt work if the grid is scrolled horizontally... on D5 at least;
- Invalidate;
- Key := 0;
- end;
-
- {$IFDEF WIN32}
- if (Key = VK_ESCAPE) then
- {$ENDIF}
- {$IFDEF LINUX}
- if (Key = KEY_ESCAPE) then
- {$ENDIF}
- DoExit;
- end;
-
- procedure TFlexCelGrid.SetZoom(const Value: integer);
- begin
- ApplySheet;
- if Value>400 then FZoom := 400
- else if Value<10 then FZoom:=10
- else FZoom:=Value;
- Zoom100:=FZoom/100;
- ResizeRowsAndCols;
- end;
-
- function TFlexCelGrid.CreateEditor: TInplaceEdit;
- begin
- Result := TFlxInplaceEdit.Create(Self);
- if InPlaceFont<>nil then (Result as TFlxInplaceEdit).Font:= InPlaceFont;
- end;
-
- procedure TFlexCelGrid.SetCell(const aRow, aCol: integer; const Text: widestring);
- var
- e:extended;
- s: string;
- begin
- if not Assigned(FFlexCelImport) or not FFlexCelImport.IsLoaded then exit;
-
- //try to convert to number
- s:=Text; //for if value is a widestring
- if TextToFloat(PChar(s), e, fvExtended) then //Dont use val because it doesnt handle locales
- FlexCelImport.CellValue[ARow, ACol]:=e else
- //try to convert to boolean
- if UpperCase(s)=TxtFalse then FlexCelImport.CellValue[ARow, ACol]:=false else
- if UpperCase(s)=TxtTrue then FlexCelImport.CellValue[ARow, ACol]:=true else
-
- FlexCelImport.CellValue[ARow, ACol]:=Text;
-
- //InvalidateRow(aRow) doesnt work if the grid is scrolled horizontally... on D5 at least;
- Invalidate;
- end;
-
- {$IFDEF WIN32}
- procedure TFlexCelGrid.WMEraseBkgnd(var Message: TWmEraseBkgnd);
- begin
- //This is to avoid flicker when we scroll
- Message.Result := 1;
- end;
-
- function TFlexCelGrid.BorderSize: integer;
- begin
- BorderSize:=0;
- end;
- {$ENDIF}
-
- { TPictureData }
-
- constructor TPictureData.Create;
- begin
- Data:=TPicture.Create;
- end;
-
- destructor TPictureData.Destroy;
- begin
- FreeAndNil(Data);
- inherited;
- end;
-
- end.
-
-