dcoutcommon.pas

XP风格的outbar.rar.有DELPHI,C++BULIDER的例子及源码

{**************************************************}
{                                                  }
{  Dream OutBar                                    }
{  Copyright (c) 1997-2001 Dream Company           }
{  http://www.dream-com.com                        }
{  e-mail: [e-mail]                   }
{                                                  }
{**************************************************}
unit dcOutCommon;

interface
Uses Windows,Classes,Graphics;

Type
  TBackgroundModeGlobal=(bkmNone,bkmGradientHorz,bkmGradientVert,bkmCenter,
                         bkmStretch,bkmTile);

  TDCVersion=type String;

  TComponentProc=Procedure(AComponent:TComponent);

Procedure FillGradient(DC:HDC;Width,Height:Integer;
                       StartColor,EndColor:TColor;IsVertical:Boolean);
Procedure HCenterRect(Var Source:TRect;const Dest:TRect);
{
Var
  SelectComponentInDesignerProc:TComponentProc;
}
implementation
Var
  CheckTrialCalled:boolean=False;

Function MaxValue(Value1,Value2,Value3:Integer):Integer;
Begin
  If Value1>Value2 Then
    Result:=Value1
  Else
    Result:=Value2;

  If Value3>Result Then
    Result:=Value3;
End;

Procedure FillGradient(DC:HDC;Width,Height:Integer;StartColor,
                       EndColor:TColor;IsVertical:Boolean);
Var
  I:Integer;
  LenRed:Integer;
  LenGreen:Integer;
  LenBlue:Integer;
  StartRed,
  StartGreen,
  StartBlue:Byte;
  MaxLen:Integer;
  Step:Integer;
  ARect:TRect;
  StepRed:Integer;
  StepGreen:Integer;
  StepBlue:Integer;
  StartRGB:Integer;
  EndRGB:Integer;
  Divisor:Integer;
  Brush:THandle;
Begin
  If IsVertical Then
    Divisor:=Height
  Else
    Divisor:=Width;
  If Divisor<=0 Then
    Exit;

  StartRGB:=ColorToRGB(StartColor);
  EndRGB:=ColorToRGB(EndColor);

  StartRed:=GetRValue(StartRGB);
  StartGreen:=GetGValue(StartRGB);
  StartBlue:=GetBValue(StartRGB);

  LenRed:=GetRValue(EndRGB)-StartRed;
  LenGreen:=GetGValue(EndRGB)-StartGreen;
  LenBlue:=GetBValue(EndRGB)-StartBlue;
  MaxLen:=MaxValue(Abs(LenRed),Abs(LenGreen),Abs(LenBlue)) + 1;
  If MaxLen=0 Then
    Exit;
  If IsVertical Then
  Begin
    Step:=Height Div MaxLen+1;
    ARect:=Rect(0,0,Width,Step)
  End
  Else
  Begin
    Step:=Width Div MaxLen+1;
    ARect:=Rect(0,0,Step,Height);
  End;
  StepRed:=Step*LenRed;
  StepGreen:=Step*LenGreen;
  StepBlue:=Step*LenBlue;
  For I:=0 To MaxLen-1 Do
  Begin
    Brush:=CreateSolidBrush(RGB(StartRed  +(I*StepRed)   Div Divisor,
                                StartGreen+(I*StepGreen) Div Divisor,
                                StartBlue +(I*StepBlue)  Div Divisor));
    FillRect(DC,ARect,Brush);
    DeleteObject(Brush);
    If IsVertical Then
    Begin
      Inc(ARect.Top,Step);
      If ARect.Top>Height Then
        Break;
      Inc(ARect.Bottom,Step)
    End
    Else
    Begin
      Inc(ARect.Left,Step);
      If ARect.Left>Width Then
        Break;
      Inc(ARect.Right,Step);
    End;
  End;
End;

Procedure HCenterRect(Var Source:TRect;const Dest:TRect);
Var
  TextHeight:Integer;
Begin
  TextHeight:=Source.Right-Source.Left;
  Source.Left:=(Dest.Right+Dest.Left-TextHeight) Div 2;
  Source.Right:=Source.Left+TextHeight;
End;

{$IFDEF DEMO}
const
  CompanyURL = 'http://www.dream-com.com'; // don't resource

const
  A2 = 'TAlignPalette'; //don't resource
  A3 = 'TPropertyInspector'; //don't resource
  A4 = 'TAppBuilder'; //don't resource

function DelphiRunning : boolean;
var
  H2, H3, H4 : Hwnd;
begin
  H2 := FindWindow(A2, nil);
  H3 := FindWindow(A3, nil);
  H4 := FindWindow(A4, nil);
  Result := (H2 <> 0) and (H3 <> 0) and (H4 <> 0);
end;

{$ENDIF}

procedure CheckTrialVersion;
begin
  If CheckTrialCalled then
    exit;
  CheckTrialCalled:=True;

  {$IFDEF Demo}
   If (Not DelphiRunning) then
     begin
       windows.MessageBox(0,'This application uses unregistered version of Dream Outbar'#13#10+   //don't resource
         'Please register. Visit '+ CompanyURL + ' for details.' //don't resource
       ,'Warning', MB_OK+MB_ICONWARNING); //don't resource
     end;
  {$ENDIF}
end;

Initialization
  CheckTrialVersion;
end.