teeprocs.pas

BCB第三方组件

{ This functions try to solve locale problems with formatting numbers }
Function DelphiToLocalFormat(Const Format:String):String;
Function LocalToDelphiFormat(Const Format:String):String;

{ For all controls in the array, set the Enabled property }
Procedure EnableControls(Enable:Boolean; Const ControlArray:Array of TControl);

{ Round "ADate" to the nearest "AStep" value }
Function TeeRoundDate(Const ADate:TDateTime; AStep:TDateTimeStep):TDateTime;

{ Increment or Decrement "Value", for DateTime and not-DateTime }
Procedure TeeDateTimeIncrement( IsDateTime:Boolean;
                                Increment:Boolean;
                                var Value:Double;
                                Const AnIncrement:Double;
                                tmpWhichDateTime:TDateTimeStep);


{ Generic "QuickSort" sorting algorithm }
type TTeeSortCompare=Function(a,b:Integer):Integer of object;
     TTeeSortSwap=Procedure(a,b:Integer) of object;

Procedure TeeSort( StartIndex,EndIndex:Integer;
                   CompareFunc:TTeeSortCompare;
                   SwapFunc:TTeeSortSwap);

{ Returns a valid component name }
Function TeeGetUniqueName(AOwner:TComponent; Const AStartName:String):TComponentName;

{ Delimited field routines }
var
  TeeFieldsSeparator:String=';';

{ Returns the "index" item in string, using "TeeFieldsSeparator" character }
Function TeeExtractField(St:String; Index:Integer):String; overload;

{ Returns the "index" item in string, using "Separator" parameter }
Function TeeExtractField(St:String; Index:Integer; const Separator:String):String; overload;

{ Returns the number of fields in string, using "TeeFieldsSeparator" character }
Function TeeNumFields(St:String):Integer; overload;
{ Returns the number of fields in string, using "Separator" parameter }
Function TeeNumFields(const St,Separator:String):Integer; overload;

{ Try to find a resource bitmap and load it }
Procedure TeeGetBitmapEditor(AObject:TObject; var Bitmap:TBitmap);
Procedure TeeLoadBitmap(Bitmap:TBitmap; Const Name1,Name2:String);

type TColorArray=Array of TColor;

{ returns one of the sample colors in default ColorPalette constant array }
Function GetDefaultColor(Const Index:Integer):TColor;

// Resets ColorPalette to default one.
Procedure SetDefaultColorPalette; overload;
Procedure SetDefaultColorPalette(const Palette:Array of TColor); overload;

var
  ColorPalette:TColorArray;

const
  TeeBorderStyle={$IFDEF CLX}fbsDialog{$ELSE}bsDialog{$ENDIF};

  TeeCheckBoxSize=11; { for TChart Legend }

  { Keyboard codes }
  TeeKey_Escape = {$IFDEF CLX}Key_Escape {$ELSE}VK_ESCAPE{$ENDIF};
  TeeKey_Up     = {$IFDEF CLX}Key_Up     {$ELSE}VK_UP{$ENDIF};
  TeeKey_Down   = {$IFDEF CLX}Key_Down   {$ELSE}VK_DOWN{$ENDIF};
  TeeKey_Insert = {$IFDEF CLX}Key_Insert {$ELSE}VK_INSERT{$ENDIF};
  TeeKey_Delete = {$IFDEF CLX}Key_Delete {$ELSE}VK_DELETE{$ENDIF};
  TeeKey_Left   = {$IFDEF CLX}Key_Left   {$ELSE}VK_LEFT{$ENDIF};
  TeeKey_Right  = {$IFDEF CLX}Key_Right  {$ELSE}VK_RIGHT{$ENDIF};
  TeeKey_Return = {$IFDEF CLX}Key_Return {$ELSE}VK_RETURN{$ENDIF};
  TeeKey_Space  = {$IFDEF CLX}Key_Space  {$ELSE}VK_SPACE{$ENDIF};
  TeeKey_Back   = {$IFDEF CLX}Key_BackSpace {$ELSE}VK_BACK{$ENDIF};

  TeeKey_F1     = {$IFDEF CLX}Key_F1     {$ELSE}VK_F1{$ENDIF};
  TeeKey_F2     = {$IFDEF CLX}Key_F2     {$ELSE}VK_F2{$ENDIF};
  TeeKey_F3     = {$IFDEF CLX}Key_F3     {$ELSE}VK_F3{$ENDIF};
  TeeKey_F4     = {$IFDEF CLX}Key_F4     {$ELSE}VK_F4{$ENDIF};
  TeeKey_F5     = {$IFDEF CLX}Key_F5     {$ELSE}VK_F5{$ENDIF};
  TeeKey_F6     = {$IFDEF CLX}Key_F6     {$ELSE}VK_F6{$ENDIF};
  TeeKey_F7     = {$IFDEF CLX}Key_F7     {$ELSE}VK_F7{$ENDIF};
  TeeKey_F8     = {$IFDEF CLX}Key_F8     {$ELSE}VK_F8{$ENDIF};
  TeeKey_F9     = {$IFDEF CLX}Key_F9     {$ELSE}VK_F9{$ENDIF};
  TeeKey_F10    = {$IFDEF CLX}Key_F10    {$ELSE}VK_F10{$ENDIF};
  TeeKey_F11    = {$IFDEF CLX}Key_F11    {$ELSE}VK_F11{$ENDIF};
  TeeKey_F12    = {$IFDEF CLX}Key_F12    {$ELSE}VK_F12{$ENDIF};

Procedure TeeDrawCheckBox( x,y:Integer; Canvas:TCanvas; Checked:Boolean;
                           ABackColor:TColor; CheckBox:Boolean=True);

{$IFNDEF D6}
function StrToFloatDef(const S: string; const Default: Extended): Extended;
function TryStrToFloat(const S: String; var Value:Double):Boolean;
{$ENDIF}

{ Returns True if line1 and line2 cross each other.
  xy is returned with crossing point. }
function CrossingLines(const X1,Y1,X2,Y2,X3,Y3,X4,Y4:Double; out x,y:Double):Boolean;

// TRANSLATIONS
type
  TTeeTranslateHook=procedure(AControl:TControl; const ExcludedChilds:Array of TControl);

var
  TeeTranslateHook:TTeeTranslateHook=nil;

// Main procedure to translate a control (or Form)
Procedure TeeTranslateControl(AControl:TControl); overload;
Procedure TeeTranslateControl(AControl:TControl; const ExcludeChilds:Array of TControl); overload;

// Replaces "Search" char with "Replace" char
// in all occurrences in AString parameter.
// Returns "AString" with replace characters.
Function ReplaceChar(const AString:String; const Search:{$IFDEF NET}String{$ELSE}Char{$ENDIF};
                     const Replace:Char=#0):String;

// Returns "P" calculating 4 rotated corners using Angle parameter
// Note: Due to a C++ Builder v5 bug, this procedure is not a function.
Procedure RectToFourPoints(Const ARect:TRect; const Angle:Double; var P:TFourPoints);

Function TeeAntiAlias(Panel:TCustomTeePanel; ChartRect:Boolean=False):TBitmap;

Procedure DrawBevel(Canvas:TTeeCanvas; Bevel:TPanelBevel; var R:TRect;
                    Width:Integer; Round:Integer=0);


function ScreenRatio(ACanvas:TCanvas3D):Double;

// Internal use. Reads and saves values from / to TRegistry / Inifile
// Used by TGalleryPanel, TChartEditor, TeeChartReg unit and TeeDesignOptions
function TeeReadBoolOption(const AKey:String; DefaultValue:Boolean):Boolean;
procedure TeeSaveBoolOption(const AKey:String; Value:Boolean);
Function TeeReadIntegerOption(const AKey:String; DefaultValue:Integer):Integer;
procedure TeeSaveIntegerOption(const AKey:String; Value:Integer);
function TeeReadStringOption(const AKey,DefaultValue:String):String;
procedure TeeSaveStringOption(const AKey,Value:String);

function TeeDefaultXMLEncoding:String;

// Converts a Stream with a *.tee file in Text format, to XML format
procedure ConvertTextToXML(Stream:TStream; XMLHeader:Boolean=True);

type
  TeeWindowHandle={$IFDEF CLX}QOpenScrollViewH{$ELSE}Integer{$ENDIF};

Procedure TeeGotoURL(Handle: TeeWindowHandle; Const URL:String);

{$IFDEF CLR}
var
  HInstance : THandle=0;  // WORKAROUND..pending.
{$ENDIF}

{$IFDEF LCL}
const
  CM_SHOWINGCHANGED = CM_BASE + 25;
{$ENDIF}

implementation

Uses {$IFDEF CLR}
     System.Runtime.InteropServices,
     System.Reflection,
     System.IO,
     System.Drawing,
     {$ENDIF}

     {$IFNDEF D5}
     {$IFNDEF LCL}
     DsgnIntf,
     {$ENDIF}
     {$ENDIF}

     Math, TypInfo,

     {$IFDEF LINUX}
     IniFiles,
     {$ELSE}
     Registry,
     {$ENDIF}

     {$IFNDEF LINUX}
     ShellApi,
     {$ENDIF}
     
     TeeConst;

{.$DEFINE MONITOR_REDRAWS}

{$IFDEF MONITOR_REDRAWS}
var RedrawCount:Integer=0;
{$ENDIF}

{$IFNDEF CLR}
{$R TeeResou.res}
{$ENDIF}

{$IFDEF CLX}
Const
  LOGPIXELSX = 0;
  LOGPIXELSY = 1;
{$ENDIF}

var
  Tee19000101:TDateTime=0; { Optimization for TeeRoundDate function, 5.02 }

{ Same as IntToStr but faster }
Function TeeStr(const Num:Integer):String; {$IFDEF D9}inline;{$ENDIF}
begin
  Str(Num,Result);
end;

// Returns one of the sample colors in default ColorPalette constant array
Function GetDefaultColor(Const Index:Integer):TColor;
Begin
  result:=ColorPalette[Low(ColorPalette)+(Index mod Succ(High(ColorPalette)))]; // 6.02
end;

{$IFDEF D5}
Function DaysInMonth(Year,Month:Word):Word;
begin
  result:=MonthDays[IsLeapYear(Year),Month]
end;
{$ELSE}
Function DaysInMonth(Year,Month:Word):Word;
Const DaysMonths:Array[1..12] of Byte=(31,28,31,30,31,30,31,31,30,31,30,31);
Begin
  result:=DaysMonths[Month];
  if (Month=2) and IsLeapYear(Year) then Inc(result);
End;
{$ENDIF}

Function DateTimeDefaultFormat(Const AStep:Double):String; {$IFDEF D9}inline;{$ENDIF}
Begin
  if AStep<=1 then result:=ShortTimeFormat
              else result:=ShortDateFormat;
end;

Function NextDateTimeStep(Const AStep:Double):Double;
var t : TDateTimeStep;
Begin
  for t:=Pred(dtOneYear) downto Low(DateTimeStep) do
  if AStep>=DateTimeStep[t] then
  Begin
    result:=DateTimeStep[Succ(t)];
    exit;
  end;
  result:=DateTimeStep[dtOneYear];
end;

Function FindDateTimeStep(Const StepValue:Double):TDateTimeStep;
var Min : Double;
begin
  Min:=DateTimeStep[Low(DateTimeStep)];
  for result:=Pred(High(DateTimeStep)) downto Low(DateTimeStep) do
      if Abs(DateTimeStep[result]-StepValue)<Min then
         exit;

  result:=dtNone;
end;

{ draw a simulated checkbox on Canvas }
Procedure TeeDrawCheckBox( x,y:Integer; Canvas:TCanvas; Checked:Boolean;
                           ABackColor:TColor; CheckBox:Boolean=True);

  {$IFDEF CLX}
  Procedure DoHorizLine(x1,x2,y:Integer);
  begin
    with Canvas do
    begin
      MoveTo(x1,y);
      LineTo(x2,y);
    end;
  end;

  Procedure DoVertLine(x,y1,y2:Integer);
  begin
    with Canvas do
    begin
      MoveTo(x,y1);
      LineTo(x,y2);
    end;
  end;
  {$ENDIF}

var t : Integer;
begin
  {$IFNDEF CLX}
  if CheckBox then t:=DFCS_BUTTONCHECK
              else t:=DFCS_BUTTONRADIO;

  if Checked then
     t:=t or DFCS_CHECKED;

  DrawFrameControl(Canvas.Handle,Bounds(x,y,13,13),DFC_BUTTON,t);

  {$ELSE}
  With Canvas do
  begin
    // RadioButton ????

    Pen.Style:=psSolid;
    Pen.Width:=1;
    Pen.Color:=clGray;
    DoHorizLine(x+TeeCheckBoxSize,x,y);
    LineTo(x,y+TeeCheckBoxSize+1);
    ABackColor:=ColorToRGB(ABackColor);
    if (ABackColor=clWhite) {$IFDEF CLX}or (ABackColor=1){$ENDIF} then
        Pen.Color:=clSilver
    else
        Pen.Color:=clWhite;
    DoHorizLine(x,x+TeeCheckBoxSize+1,y+TeeCheckBoxSize+1);

    LineTo(x+TeeCheckBoxSize+1,y-1);
    Pen.Color:=clBlack;
    DoHorizLine(x+TeeCheckBoxSize-1,x+1,y+1);
    LineTo(x+1,y+TeeCheckBoxSize);

    Brush.Style:=bsSolid;
    Brush.Color:=clWindow;
    Pen.Style:=psClear;
    Rectangle(x+2,y+2,x+TeeCheckBoxSize+1,y+TeeCheckBoxSize+1);

    if Checked then
    begin
      Pen.Style:=psSolid;
      Pen.Color:=clWindowText;
      for t:=1 to 3 do DoVertLine(x+2+t,y+4+t,y+7+t);
      for t:=1 to 4 do DoVertLine(x+5+t,y+7-t,y+10-t);
    end;
  end;
  {$ENDIF}
end;

{ TCustomPanelNoCaption }
Constructor TCustomPanelNoCaption.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle:=ControlStyle-[csSetCaption {$IFDEF CLX},csNoFocus{$ENDIF} ];
end;

{$IFNDEF CLR}
type
  TChartPenAccess=class(TChartPen);
{$ENDIF}

{ TCustomTeePanel }
Constructor TCustomTeePanel.Create(AOwner: TComponent);
begin
  inherited;
  IEventListeners:=TTeeEventListeners.Create;

  Width := 400;
  Height:= 250;

  FApplyZOrder :=True;
  FDelphiCanvas:=inherited Canvas;

  FView3D      :=True;
  FView3DOptions:=TView3DOptions.Create({$IFDEF TEEVCL}Self{$ENDIF});

  InternalCanvas:=TTeeCanvas3D.Create;
  InternalCanvas.ReferenceCanvas:=FDelphiCanvas;

  FMargins:= TeeRect( TeeDefHorizMargin,TeeDefVerticalMargin,
                      TeeDefHorizMargin,TeeDefVerticalMargin);
  FPrintProportional:=True;
  FPrintResolution:=TeeNormalPrintDetail;

  FPrintMargins.Left:=TeeDefault_PrintMargin;
  FPrintMargins.Right:=TeeDefault_PrintMargin;
  FPrintMargins.Top:=TeeDefault_PrintMargin;
  FPrintMargins.Bottom:=TeeDefault_PrintMargin;

  FOriginalCursor:=Cursor;
  FPanning:=TZoomPanning.Create;

  FShadow:=TTeeShadow.Create(CanvasChanged);
  FBorder:=TChartHiddenPen.Create(CanvasChanged);
  FBorder.EndStyle:=esFlat;

  {$IFDEF CLR}
  FBorder.DefaultEnd:=esFlat;
  {$ELSE}
  TChartPenAccess(FBorder).DefaultEnd:=esFlat;
  {$ENDIF}

  if TeeEraseBack then
     TeeEraseBack:=not (csDesigning in ComponentState);

  AutoRepaint:=True;

  {$IFDEF CLX}
  // Avoid flicker when resizing or repainting 
  QWidget_setBackgroundMode(Handle,QWidgetBackgroundMode_NoBackground);
  {$ENDIF}
end;

Destructor TCustomTeePanel.Destroy;
Begin
  FreeAndNil(InternalCanvas);
  FBorder.Free;
  FShadow.Free;
  FView3DOptions.Free;
  FPanning.Free;
  FreeAndNil(IEventListeners);
  inherited;
end;

Procedure TCustomTeePanel.CanvasChanged(Sender:TObject);
Begin
  Invalidate;
end;

{$IFNDEF CLX}
{$IFNDEF LCL}
procedure TCustomTeePanel.CreateParams(var Params: TCreateParams);
begin
  inherited;

// OpenGL:
// Params.WindowClass.Style:=Params.WindowClass.Style or CS_OWNDC;

  if Color=clNone then
     Params.ExStyle:=Params.ExStyle or WS_EX_TRANSPARENT; { 5.02 }

  InternalCanvas.View3DOptions:=nil;