?? bsutils.pas
字號:
{*******************************************************************}
{ }
{ Almediadev Visual Component Library }
{ BusinessSkinForm }
{ Version 6.15 }
{ }
{ Copyright (c) 2000-2008 Almediadev }
{ ALL RIGHTS RESERVED }
{ }
{ Home: http://www.almdev.com }
{ Support: support@almdev.com }
{ }
{*******************************************************************}
unit bsUtils;
{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}
interface
{$R-}
uses
Windows, Controls, Messages, SysUtils, Classes, Graphics, IniFiles, ImgList;
const
maxi = 10000;
// xp office color consts
BS_XP_BTNFRAMECOLOR = 8388608;
BS_XP_BTNACTIVECOLOR = 13811126;
BS_XP_BTNDOWNCOLOR = 11899781;
CM_SEPAINT = CM_BASE + 456;
CM_SENCPAINT = CM_BASE + 457;
SE_RESULT = $3233;
CM_CANSTARTFORMANIMATION = CM_BASE + 434;
SE_STOPANIMATION = $3234;
SE_CANANIMATION = $3235;
type
TCharSet = set of char;
TbsStretchType = (bsstFull, bsstHorz, bsstVert);
{ TbsFBitmap }
TFBColor = record b,g,r:Byte end;
PFBColor =^TFBColor;
TBLine = array[0..0]of TFBColor;
PBLine =^TBLine;
TPLines = array[0..0]of PBLine;
PPLines =^TPLines;
TbsFBitmap = class
private
Bits: Pointer;
procedure Initialize;
public
Pixels: PPLines;
Gap,
RowInc,
Size,
Width,
Height: Integer;
Handle,
hDC: Integer;
bmInfo: TBitmapInfo;
bmHeader: TBitmapInfoHeader;
constructor Create(HBmp:Integer);
destructor Destroy; override;
end;
TRectArray = array[0..maxi] of TRect;
TbsNumGlyphs = 1..4;
TbsButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
//
function EqRects(R1, R2: TRect): Boolean;
function EqPoints(const Pt1, Pt2: TPoint): Boolean;
function NullRect: TRect;
function IsNullRect(R: TRect): Boolean;
function IsNullPoint(P: TPoint): Boolean;
function RectInRect(R1, R2: TRect): Boolean;
//
function RectWidth(R: TRect): Integer;
function RectHeight(R: TRect): Integer;
function RectToCenter(var R: TRect; Bounds: TRect): TRect;
// Region functions
function CreateRgnFromBmp(B: TBitmap; XO, YO: Integer; var RgnData: PRgnData): integer;
// Stream functions
procedure WriteStringToStream(Str: String; S: TStream);
procedure ReadStringFromStream(var Str: String; S: TStream);
// Skin functions
function GetRect(S: String): TRect;
function GetPoint(S: String): TPoint;
function SetRect(R: TRect): String;
procedure CreateSkinBorderImages(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
LeftB, TopB, RightB, BottomB, SB: TBitMap; R: TRect; AW, AH: Integer;
LS, TS, RS, BS: Boolean);
procedure CreateSkinImageBS(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
B, SB: TBitMap; R: TRect; AW, AH: Integer; DrawClient: Boolean;
LS, TS, RS, BS: Boolean; AStretchEffect: Boolean; AStretchType: TbsStretchType);
procedure CreateSkinBG(ClRect: TRect; NewClRect: TRect;
B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean;
AStretchType: TbsStretchType);
procedure CreateSkinImage(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
B, SB: TBitMap; R: TRect; AW, AH: Integer; ADrawClient: Boolean;
ALeftStretch, ATopStretch, ARightStretch, ABottomStretch,
AClientStretch: Boolean; AStretchType: TbsStretchType);
procedure CreateSkinImage2(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
B, SB: TBitMap; R: TRect; AW, AH: Integer; ADrawClient,
ALeftStretch, ATopStretch, ARightStretch, ABottomStretch,
AClientStretch: Boolean; AStretchType: TbsStretchType);
procedure CreateStretchImage(B: TBitMap; SB: TBitMap; R: TRect; ClRect: TRect;
ADrawClient: Boolean);
procedure CreateHSkinImage(LO, RO: Integer;
B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean);
procedure CreateHSkinImage2(LO, RO: Integer;
B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean);
procedure CreateHSkinImage3(LO, RO: Integer;
B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean);
procedure CreateVSkinImage(TpO, BO: Integer;
B, SB: TBitMap; R: TRect; AW, AH: Integer; AStretch: Boolean);
procedure CreateSkinMask(LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
FMask, RMTop, RMLeft, RMRight, RMBottom: TBitMap; AW, AH: Integer);
procedure CreateSkinSimplyRegion(var FRgn: HRgn; FMask: TBitMap);
procedure CreateSkinRegion(var FRgn: HRgn;
LtPt, RTPt, LBPt, RBPt: TPoint; ClRect: TRect;
NewLTPt, NewRTPt, NewLBPt, NewRBPt: TPoint; NewClRect: TRect;
FMask: TBitMap; AW, AH: Integer);
procedure DrawGlyph(Cnvs: TCanvas; X, Y: Integer; FGlyph: TBitMap;
FNumGlyphs, FGlyphNum: Integer);
// IniFile funcitons
function ReadRect(IniFile: TCustomIniFile; Section: String; Ident: String): TRect;
function ReadPoint(IniFile: TCustomIniFile; Section: String; Ident: String): TPoint;
function ReadBoolean(IniFile: TCustomIniFile; Section: String; Ident: String): Boolean;
function ReadFontStyles(IniFile: TCustomIniFile;
Section: String; Ident: String): TFontStyles;
procedure ReadStrings(IniFile: TCustomIniFile;
Section: String; Ident: String; S: TStrings);
procedure ReadStrings1(IniFile: TCustomIniFile;
Section: String; Ident: String; S: TStrings);
function ReadAlignment(IniFile: TCustomIniFile;
Section: String; Ident: String): TAlignment;
procedure WriteAlignment(IniFile: TCustomIniFile;
Section: String; Ident: String; A: TAlignment);
procedure WriteRect(IniFile: TCustomIniFile; Section: String; Ident: String; R: TRect);
procedure WritePoint(IniFile: TCustomIniFile; Section: String; Ident: String; P: TPoint);
procedure WriteBoolean(IniFile: TCustomIniFile; Section: String; Ident: String; B: Boolean);
procedure WriteFontStyles(IniFile: TCustomIniFile;
Section: String; Ident: String; FS: TFontStyles);
procedure WriteStrings(IniFile: TCustomIniFile;
Section: String; Ident: String; S: TStrings);
procedure WriteStrings1(IniFile: TCustomIniFile;
Section: String; Ident: String; S: TStrings);
procedure GetScreenImage(X, Y: Integer; B: TBitMap);
procedure GetWindowsVersion(var Major, Minor: Integer);
function CheckW2KWXP: Boolean;
function CheckWXP: Boolean;
procedure SetAlphaBlendTransparent(WHandle: HWnd; Value: Byte);
procedure Frm3D(Canvas: TCanvas; Rect: TRect; TopColor, BottomColor: TColor);
procedure DrawRadioImage(Cnvs: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawCheckImage(Cnvs: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawArrowImage(Cnvs: TCanvas; R: TRect; Color: TColor; Code: Integer);
procedure DrawTrackArrowImage(Cnvs: TCanvas; R: TRect; Color: TColor);
function PointInRect(R: TRect; P: TPoint): Boolean;
function CalcTextWidthW(C: TCanvas; Str: WideString): Integer;
function CalcTextHeightW(C: TCanvas; Str: WideString): Integer;
function BSDrawSkinText(ACanvas: TCanvas; AText: WideString; var Bounds: TRect; Flag: cardinal): integer;
procedure BSDrawText(Cnvs: TCanvas; S: String; R: TRect);
procedure BSDrawText2(Cnvs: TCanvas; S: String; R: TRect);
procedure BSDrawText3(Cnvs: TCanvas; S: String; R: TRect; HorOffset: Integer);
procedure BSDrawText4(Cnvs: TCanvas; S: String; R: TRect);
procedure DrawCloseImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawRCloseImage(C: TCanvas; R: TRect; Color: TColor);
procedure DrawMinimizeImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawMaximizeImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawRollUpImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawRestoreRollUpImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawRestoreImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawSysMenuImage(C: TCanvas; X, Y: Integer; Color: TColor);
procedure DrawMTImage(C: TCanvas; X, Y: Integer; Color: TColor);
function ExtractDay(ADate: TDateTime): Word;
function ExtractMonth(ADate: TDateTime): Word;
function ExtractYear(ADate: TDateTime): Word;
function IsLeapYear(AYear: Integer): Boolean;
function DaysPerMonth(AYear, AMonth: Integer): Integer;
function ReplaceStr(const S, Srch, Replace: string): string;
function Max(A, B: Longint): Longint;
function Min(A, B: Longint): Longint;
procedure CorrectTextbyWidth(C: TCanvas; var S: String; W: Integer);
procedure CorrectTextbyWidthW(C: TCanvas; var S: WideString; W: Integer);
procedure GetParentImage(Control: TControl; Dest: TCanvas);
procedure GetParentImageRect(Control: TControl; Rct: TRect; Dest: TCanvas);
function GetMonitorWorkArea(const W: HWND; const WorkArea: Boolean): TRect;
function GetPrimaryMonitorWorkArea(const WorkArea: Boolean): TRect;
function MyGetScrollBarInfo(wnd: Cardinal; idObject: Longint; var psbi: TScrollBarInfo): BOOL;
function IsVistaOs: Boolean;
function Is9XOS: Boolean;
procedure CalcLCoord(Layout: TbsButtonLayout; R: TRect; gw, gh, tw, th: Integer;
Spacing, Margin: Integer; var tx, ty, gx, gy: Integer);
procedure DrawGlyphAndText(Cnvs: TCanvas;
R: TRect; Margin, Spacing: Integer; Layout: TbsButtonLayout;
Caption: String; Glyph: TBitMap; NumGlyphs, GlyphNum: Integer; ADown: Boolean;
ADrawColorMarker: Boolean; AColorMarkerValue: TColor);
procedure DrawImageAndText(Cnvs: TCanvas; R: TRect; Margin, Spacing: Integer;
Layout: TbsButtonLayout;
Caption: String; ImageIndex: Integer; IL: TCustomIMageList; ADown: Boolean;
AEnabled: Boolean; ADrawColorMarker: Boolean; AColorMarkerValue: TColor);
var
BS_PlatformIsUnicode: Boolean;
GetScrollBarInfoFunc: function (wnd: Cardinal; idObject: Longint; var psbi: TScrollBarInfo): BOOL; stdcall;
implementation
uses Forms, Consts, bsSkinTabs;
const
LWA_ALPHA = $2;
type
TParentControl = class(TWinControl);
function MyGetScrollBarInfo(wnd: Cardinal; idObject: Longint; var psbi: TScrollBarInfo): BOOL;
begin
if @GetScrollBarInfoFunc <> nil then
Result := GetScrollBarInfoFunc(wnd, idObject, psbi)
else
begin
{ Win95 }
psbi.rgstate[0] := STATE_SYSTEM_INVISIBLE;
Result := false;
end;
end;
procedure CalcLCoord(Layout: TbsButtonLayout; R: TRect; gw, gh, tw, th: Integer;
Spacing, Margin: Integer; var tx, ty, gx, gy: Integer);
var
H, W, H1, W1: Integer;
begin
H := R.Top + RectHeight(R) div 2;
W := R.Left + RectWidth(R) div 2;
if Margin = -1
then
begin
W1 := (tw + gw + Spacing) div 2;
H1 := (th + gh + Spacing) div 2;
case Layout of
blGlyphRight:
begin
tx := W - W1;
ty := H - th div 2;
gx := W + W1 - gw;
gy := H - gh div 2;
end;
blGlyphLeft:
begin
gx := W - W1;
gy := H - gh div 2;
tx := W + W1 - tw;
ty := H - th div 2;
end;
blGlyphTop:
begin
tx := W - tw div 2;
ty := H + H1 - th;
gx := W - gw div 2;
gy := H - H1;
end;
blGlyphBottom:
begin
gx := W - gw div 2;
gy := H + H1 - gh;
tx := W - tw div 2;
ty := H - H1;
end;
end;
end
else
begin
case Layout of
blGlyphRight:
begin
gy := H - gh div 2;
gx := R.Right - gw - Margin;
tx := gx - Spacing - tw;
ty := H - th div 2;
end;
blGlyphLeft:
begin
gy := H - gh div 2;
gx := R.Left + Margin;
tx := gx + gw + Spacing;
ty := H - th div 2;
end;
blGlyphTop:
begin
gy := R.Top + Margin;
gx := W - gw div 2;
ty := gy + gh + Spacing;
tx := W - tw div 2;
end;
blGlyphBottom:
begin
gy := R.Bottom - gh - Margin;
gx := W - gw div 2;
ty := gy - Spacing - th;
tx := W - tw div 2;
end;
end;
end;
end;
procedure DrawImageAndText(Cnvs: TCanvas; R: TRect; Margin, Spacing: Integer;
Layout: TbsButtonLayout;
Caption: String; ImageIndex: Integer; IL: TCustomIMageList; ADown: Boolean;
AEnabled: Boolean; ADrawColorMarker: Boolean; AColorMarkerValue: TColor);
var
gw, gh: Integer;
tw, th: Integer;
TX, TY, GX, GY: Integer;
TR: TRect;
begin
if (ImageIndex < 0) or (IL = nil) or (ImageIndex >= IL.Count)
then
begin
gw := 0;
gh := 0;
end
else
begin
gw := IL.Width;
gh := IL.Height;
end;
with Cnvs do
begin
if Caption = ''
then
begin
tw := 0;
th := 0;
end
else
begin
TR := Rect(0, 0, RectWidth(R), RectHeight(R));
if (Layout = blGlyphLeft) or (Layout = blGlyphRight)
then
begin
Dec(TR.Right, gw);
end
else
if (Layout = blGlyphTop) or (Layout = blGlyphBottom)
then
begin
Dec(TR.Bottom, gh);
end;
DrawText(Handle, PChar(Caption), Length(Caption), TR,
DT_EXPANDTABS or DT_WORDBREAK or DT_CALCRECT);
tw := RectWidth(TR);
th := RectHeight(TR);
end;
Brush.Style := bsClear;
end;
CalcLCoord(Layout, R, gw, gh, tw, th, Spacing, Margin, TX, TY, GX, GY);
if ADown
then
begin
Inc(GX); Inc(GY);
Inc(TX); Inc(TY);
end;
if Caption <> ''
then
begin
TR := Rect(TX, TY, TX + tw, TY + th);
Inc(TR.Right, 2);
DrawText(Cnvs.Handle, PChar(Caption), Length(Caption), TR, DT_EXPANDTABS or DT_VCENTER or DT_CENTER or DT_WORDBREAK);
end;
if gw <> 0
then
begin
IL.Draw(Cnvs, GX, GY, ImageIndex, AEnabled);
if ADrawColorMarker
then
with Cnvs do
begin
Pen.Color := AColorMarkerValue;
MoveTo(GX, GY + IL.Height - 2);
LineTo(GX + IL.Width, GY + IL.Height - 2);
MoveTo(GX, GY + IL.Height - 1);
LineTo(GX + IL.Width, GY + IL.Height - 1);
MoveTo(GX, GY + IL.Height);
LineTo(GX + IL.Width, GY + IL.Height);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -