📄 teeprocs.pas

📁 第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。该
💻 PAS
📖 第 1 页 / 共 5 页
字号:

{ 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;
{$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; var 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):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 a boolean from / to TRegistry / Inifile
// Used by TGalleryPanel, TChartEditor 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);

{$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}
     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;
  PrintMargins:=TeeRect( TeeDefault_PrintMargin,TeeDefault_PrintMargin,
                         TeeDefault_PrintMargin,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;
end;
{$ENDIF}
{$ENDIF}

Procedure TCustomTeePanel.SetShadow(Value:TTeeShadow);
begin
  FShadow.Assign(Value);
end;

Procedure TCustomTeePanel.InternalDraw(Const UserRectangle:TRect); // virtual; abstract;
begin
end;

procedure TCustomTeePanel.SetView3DOptions(Value:TView3DOptions);
begin
  FView3DOptions.Assign(Value);
end;

procedure TCustomTeePanel.SetView3D(Value:Boolean);
Begin
  if FView3D<>Value then // 6.0
  begin
    SetBooleanProperty(FView3D,Value);
    BroadcastTeeEvent(TTeeView3DEvent.Create).Free;
  end;
end;

Procedure TCustomTeePanel.Draw;
begin
  Draw(FDelphiCanvas,GetClientRect);
end;

type
  TCanvasAccess=class {$IFDEF CLR}sealed{$ENDIF} (TTeeCanvas3D);

Procedure TCustomTeePanel.Draw(UserCanvas:TCanvas; Const UserRect:TRect);

  Procedure AdjustChartBounds;

    Function GetMargin(Value,Range:Integer):Integer;
    begin
      if MarginUnits=muPercent then result:=Value*Range div 100
                               else result:=Value;
    end;

  Var tmpW : Integer;
      tmpH : Integer;
      tmpBorder : Integer;
  begin
    RectSize(FChartBounds,tmpW,tmpH);

    // Calculate amount of pixels for border and bevels...
    tmpBorder:=BorderWidth;
    if BevelInner<>bvNone then Inc(tmpBorder,BevelWidth);
    if BevelOuter<>bvNone then Inc(tmpBorder,BevelWidth);
    if Border.Visible then Inc(tmpBorder,Border.Width);

    // Apply margins
    With FChartBounds do
         ChartRect:=TeeRect( Left  + tmpBorder + GetMargin(MarginLeft,tmpW),
                             Top   + tmpBorder + GetMargin(MarginTop,tmpH),
                             Right - tmpBorder - GetMargin(MarginRight,tmpW),
                             Bottom- tmpBorder - GetMargin(MarginBottom,tmpH) );
  end;

Begin
  {$IFDEF CLX}
  UserCanvas.Start;
  try
  {$ENDIF}

  FChartBounds:=InternalCanvas.InitWindow(UserCanvas,FView3DOptions,Color,FView3D,UserRect);

  AdjustChartBounds;
  RecalcWidthHeight;
  InternalDraw(FChartBounds);

{$IFDEF MONITOR_REDRAWS}
  Inc(RedrawCount);
  InternalCanvas.TextAlign:=TA_LEFT;
  InternalCanvas.Font.Size:=8;
  TCanvasAccess(InternalCanvas).IFont:=nil;
  InternalCanvas.TextOut(0,0,TeeStr(RedrawCount));
{$ENDIF}
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -