Здравствуйте, Аноним, Вы писали:
А>Буду очень благодарен. Не важно на чем — главное близко к WinAPI и вид "стандартный"
Так выглядит моя процедура рисования progressbar`а с поддержкой стандартной процедуры рисования, поддержкой тем и поддержкой Vista:
unit decProgressUtils;
// (C) Dec Anisimov
// Не забывайте вызывать DoneUxTheme при приходе WM_THEMECHANGED и
// в конце работы приложения
interface
uses Windows, Types;
type
TProgressBarState = (pbsNormal, pbsError, pbsPaused, pbsPartial);
procedure DrawProgressBar(ADC: HDC; const ARect: TRect; AMin, AMax, APos: Integer;
AState: TProgressBarState = pbsNormal; AHorizontal: Boolean = True;
ADoubleBuffered: Boolean = True; ATransparent: Boolean = False);
procedure DoneUxTheme;
implementation
const
VSCLASS_PROGRESSSTYLE = 'PROGRESSSTYLE';
VSCLASS_PROGRESS = 'PROGRESS';
PROGRESSPartFiller0 = 0;
PP_BAR = 1;
PP_BARVERT = 2;
PP_CHUNK = 3;
PP_CHUNKVERT = 4;
{ For Windows >= Vista }
PP_FILL = 5;
PP_FILLVERT = 6;
PP_PULSEOVERLAY = 7;
PP_MOVEOVERLAY = 8;
PP_PULSEOVERLAYVERT = 9;
PP_MOVEOVERLAYVERT = 10;
PP_TRANSPARENTBAR = 11;
PP_TRANSPARENTBARVERT = 12;
{ For Windows >= Vista }
PBBS_NORMAL = 1;
PBBS_PARTIAL = 2;
PBBVS_NORMAL = 1;
PBBVS_PARTIAL = 2;
PBFS_NORMAL = 1;
PBFS_ERROR = 2;
PBFS_PAUSED = 3;
PBFS_PARTIAL = 4;
PBFVS_NORMAL = 1;
PBFVS_ERROR = 2;
PBFVS_PAUSED = 3;
PBFVS_PARTIAL = 4;
TMT_PROGRESSCHUNKSIZE = 2411;
TMT_PROGRESSSPACESIZE = 2412;
type
HTHEME = THANDLE;
var
Inited: Boolean;
ThemeLibrary: THandle;
ProgressTheme: HTHEME;
ChunkSize: Integer;
ChunkSpace: Integer;
ChunkSizeVert: Integer;
ChunkSpaceVert: Integer;
IsThemeActive: function: BOOL; stdcall;
IsAppThemed: function: BOOL; stdcall;
OpenThemeData: function(hwnd: HWND; pszClassList: LPCWSTR): HTHEME; stdcall;
CloseThemeData: function(hTheme: HTHEME): HRESULT; stdcall;
DrawThemeBackground: function(hTheme: HTHEME; hdc: HDC; iPartId,
iStateId: Integer; const pRect: TRect; pClipRect: PRECT): HRESULT; stdcall;
GetThemeBackgroundContentRect: function(hTheme: HTHEME; hdc: HDC;
iPartId, iStateId: Integer; const pBoundingRect: TRect;
pContentRect: PRECT): HRESULT; stdcall;
IsThemePartDefined: function(hTheme: HTHEME; iPartId, iStateId: Integer): BOOL; stdcall;
GetThemeMetric: function(hTheme: HTHEME; hdc: HDC; iPartId, iStateId, iPropId: Integer;
var piVal: Integer): HRESULT; stdcall;
procedure InitUxTheme;
begin
if Inited then Exit;
ThemeLibrary := LoadLibrary('uxtheme.dll');
if ThemeLibrary > 0 then
begin
Inited := True;
IsThemeActive := GetProcAddress(ThemeLibrary, 'IsThemeActive');
IsAppThemed := GetProcAddress(ThemeLibrary, 'IsAppThemed');
OpenThemeData := GetProcAddress(ThemeLibrary, 'OpenThemeData');
CloseThemeData := GetProcAddress(ThemeLibrary, 'CloseThemeData');
DrawThemeBackground := GetProcAddress(ThemeLibrary, 'DrawThemeBackground');
GetThemeBackgroundContentRect := GetProcAddress(ThemeLibrary, 'GetThemeBackgroundContentRect');
IsThemePartDefined := GetProcAddress(ThemeLibrary, 'IsThemePartDefined');
GetThemeMetric := GetProcAddress(ThemeLibrary, 'GetThemeMetric');
ProgressTheme := OpenThemeData(0, VSCLASS_PROGRESS);
GetThemeMetric(ProgressTheme, 0, PP_CHUNK, 0, TMT_PROGRESSCHUNKSIZE, ChunkSize);
GetThemeMetric(ProgressTheme, 0, PP_CHUNK, 0, TMT_PROGRESSSPACESIZE, ChunkSpace);
GetThemeMetric(ProgressTheme, 0, PP_CHUNKVERT, 0, TMT_PROGRESSCHUNKSIZE, ChunkSizeVert);
GetThemeMetric(ProgressTheme, 0, PP_CHUNKVERT, 0, TMT_PROGRESSSPACESIZE, ChunkSpaceVert);
end;
end;
procedure DoneUxTheme;
begin
if not Inited then Exit;
if ProgressTheme <> 0 then CloseThemeData(ProgressTheme);
if ThemeLibrary > 0 then FreeLibrary(ThemeLibrary);
Inited := False;
end;
function UseThemes: Boolean;
begin
if ThemeLibrary > 0 then Result := IsAppThemed and IsThemeActive and (ProgressTheme <> 0)
else Result := False;
end;
// Эмуляция состояний, отличтных от pbsNormal
function DrawChunksEmulate(ADC: HDC; ARect: TRect; APartID, AStateID: Integer;
AState: TProgressBarState): Boolean;
var W, H: integer;
DC: HDC;
Bitmap, OldBitmap: HBITMAP;
BitmapInfo: TBitmapInfo;
BPSL: Integer;
Step: Integer;
Bits: Pointer;
X, Y: integer;
R, G, B: PByte;
Gr: Integer;
begin
Result := False;
with ARect do
begin
W := Right - Left;
H := Bottom - Top;
end;
with ARect do
Bitmap := CreateCompatibleBitmap(ADC, W, H);
if Bitmap <> 0 then
try
DC := CreateCompatibleDC(ADC);
if DC <> 0 then
try
OldBitmap := SelectObject(DC, Bitmap);
try
with ARect do
begin
BitBlt(DC, 0, 0, Right - Left, Bottom - Top, ADC, Left, Top, SRCCOPY);
DrawThemeBackground(ProgressTheme, DC, APartID, AStateID, Rect(0, 0, W, H), nil);
end;
ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo));
with BitmapInfo.bmiHeader do
begin
biSize := SizeOf(TBitmapInfoHeader);
biWidth := W;
biHeight := H;
biPlanes := 1;
biBitCount := 24;
end;
BPSL := (((W * BitmapInfo.bmiHeader.biBitCount) + 31) and not 31) div 8;
Step := BitmapInfo.bmiHeader.biBitCount div 8;
GetMem(Bits, BPSL * H);
try
GetDIBits(DC, Bitmap, 0, H, Bits, BitmapInfo, DIB_RGB_COLORS);
for Y := 0 to H - 1 do
begin
B := Pointer(Integer(Bits) + BPSL * Y);
G := B; Inc(G);
R := G; Inc(R);
for X := 0 to W - 1 do
begin
// Convert to grayscale
Gr := Round((0.30 * R^) + (0.59 * G^) + (0.11 * B^));
if Gr > 255 then Gr := 255;
case AState of
pbsError: begin R^ := Gr; G^ := 0; B^ := 0; end;
pbsPaused: begin R^ := Gr; G^ := Gr; B^ := 0; end;
pbsPartial: begin R^ := 0; G^ := 0; B^ := Gr; end;
end;
Inc(B, Step);
Inc(G, Step);
Inc(R, Step);
end;
end;
SetDIBits(DC, Bitmap, 0, H, Bits, BitmapInfo, DIB_RGB_COLORS);
finally
FreeMem(Bits)
end;
with ARect do
BitBlt(ADC, Left, Top, W, H, DC, 0, 0, SRCCOPY);
Result := True;
finally
SelectObject(DC, OldBitmap);
end;
finally
DeleteDC(DC);
end;
finally
DeleteObject(Bitmap);
end;
end;
procedure DrawProgressBarThemed(ADC: HDC; const ARect: TRect; AMin, AMax, APos: Integer;
AState: TProgressBarState; AHorizontal: Boolean; ATransparent: Boolean);
var PartID1, PartID2: Integer;
StateID1, StateID2: Integer;
CRect0, CRect, WRect: TRect;
S: Double;
i, M: Integer;
begin
if AHorizontal then
begin
if ATransparent and IsThemePartDefined(ProgressTheme, PP_TRANSPARENTBAR, 0) then
begin
PartID1 := PP_TRANSPARENTBAR;
StateID1 := PBBS_NORMAL;
end
else
begin
PartID1 := PP_BAR;
StateID1 := 0;
end;
if IsThemePartDefined(ProgressTheme, PP_FILL, 0) then
begin
PartID2 := PP_FILL;
StateID2 := PBFS_NORMAL;
end
else
begin
PartID2 := PP_CHUNK;
StateID2 := 0;
end;
end
else
begin
if ATransparent and IsThemePartDefined(ProgressTheme, PP_TRANSPARENTBARVERT, 0) then
begin
PartID1 := PP_TRANSPARENTBARVERT;
StateID1 := PBBVS_NORMAL;
end
else
begin
PartID1 := PP_BARVERT;
StateID1 := 0;
end;
if IsThemePartDefined(ProgressTheme, PP_FILLVERT, 0) then
begin
PartID2 := PP_FILLVERT;
StateID2 := PBFVS_NORMAL;
end
else
begin
PartID2 := PP_CHUNKVERT;
StateID2 := 0;
end;
end;
DrawThemeBackground(ProgressTheme, ADC, PartID1, StateID1, ARect, nil);
GetThemeBackgroundContentRect(ProgressTheme, ADC, PartID1, StateID1, ARect, @CRect0);
if (CRect0.Right > CRect0.Left) and (CRect0.Bottom > CRect0.Top) then
begin
S := (APos - AMin) / (AMax - AMin);
CRect := CRect0;
with CRect do
if AHorizontal then Right := Left + Trunc((Right - Left) * S)
else Top := Bottom - Trunc((Bottom - Top) * S);
if (PartID2 = PP_FILL) or (PartID2 = PP_FILLVERT) then
DrawThemeBackground(ProgressTheme, ADC, PartID2, Ord(AState) + 1, CRect, nil)
else
begin
WRect := CRect;
if AHorizontal then
begin
if ChunkSize + ChunkSpace = 0 then
M := 1
else
begin
M := (CRect.Right - CRect.Left) div (ChunkSize + ChunkSpace);
if (CRect.Right - CRect.Left) mod (ChunkSize + ChunkSpace) > 0 then
Inc(M);
WRect.Right := WRect.Left + ChunkSize;
end;
end
else
begin
if ChunkSizeVert + ChunkSpaceVert = 0 then
M := 1
else
begin
M := (CRect.Bottom - CRect.Top) div (ChunkSizeVert + ChunkSpaceVert);
if (CRect.Bottom - CRect.Top) mod (ChunkSizeVert + ChunkSpaceVert) > 0 then
Inc(M);
WRect.Top := WRect.Bottom - ChunkSizeVert;
end;
end;
for i := 0 to M - 1 do
begin
if (AState = pbsNormal) or not DrawChunksEmulate(ADC, WRect, PartID2, StateID2, AState) then
DrawThemeBackground(ProgressTheme, ADC, PartID2, StateID2, WRect, nil);
if AHorizontal then
begin
WRect.Left := WRect.Left + ChunkSize + ChunkSpace;
WRect.Right := WRect.Left + ChunkSize;
if WRect.Right > CRect0.Right then
WRect.Right := CRect0.Right;
end
else
begin
WRect.Bottom := WRect.Bottom - ChunkSizeVert - ChunkSpaceVert;
WRect.Top := WRect.Bottom - ChunkSizeVert;
if WRect.Top < CRect0.Top then
WRect.Top := CRect0.Top;
end;
end;
end;
end;
end;
procedure DrawProgressBarStandard(ADC: HDC; const ARect: TRect; AMin, AMax, APos: Integer;
AState: TProgressBarState = pbsNormal; AHorizontal: Boolean = True);
var Pen, OldPen: HPEN;
LogBruhs: TLogBrush;
Brush, OldBrush: HBRUSH;
CRect0, CRect, WRect: TRect;
S: Double;
Step, i, M: Integer;
begin
with ARect do
begin
Pen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW));
try
OldPen := SelectObject(ADC, Pen);
MoveToEx(ADC, Left, Bottom - 1, nil);
LineTo(ADC, Left, Top);
LineTo(ADC, Right - 1, Top);
Pen := SelectObject(ADC, OldPen);
finally
DeleteObject(Pen);
end;
Pen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT));
try
OldPen := SelectObject(ADC, Pen);
MoveToEx(ADC, Left, Bottom - 1, nil);
LineTo(ADC, Right - 1, Bottom - 1);
LineTo(ADC, Right - 1, Top - 1);
Pen := SelectObject(ADC, OldPen);
finally
DeleteObject(Pen);
end;
CRect0 := Rect(Left + 1, Top + 1, Right - 1, Bottom - 1);
end;
if (CRect0.Right > CRect0.Left) and (CRect0.Bottom > CRect0.Top) then
begin
with CRect0 do
begin
LogBruhs.lbStyle := BS_SOLID;
LogBruhs.lbColor := GetSysColor(COLOR_BTNFACE);
LogBruhs.lbHatch := 0;
Brush := CreateBrushIndirect(LogBruhs);
try
OldBrush := SelectObject(ADC, Brush);
FillRect(ADC, CRect0, Brush);
Brush := SelectObject(ADC, OldBrush);
finally
DeleteObject(Brush);
end;
CRect0 := Rect(Left + 1, Top + 1, Right - 1, Bottom - 1);
end;
if (CRect0.Right > CRect0.Left) and (CRect0.Bottom > CRect0.Top) then
begin
S := (APos - AMin) / (AMax - AMin);
CRect := CRect0;
with CRect do
if AHorizontal then Right := Left + Trunc((Right - Left) * S)
else Top := Bottom - Trunc((Bottom - Top) * S);
WRect := CRect;
if AHorizontal then
begin
Step := Trunc((CRect.Bottom - CRect.Top) / 1.5);
if Step = 0 then Step := 1;
WRect.Right := WRect.Left + Step;
M := (CRect.Right - CRect.Left) div (Step + 2);
if (CRect.Right - CRect.Left) mod (Step + 2) > 0 then
Inc(M);
end
else
begin
Step := Trunc((CRect.Right - CRect.Left) / 1.5);
if Step = 0 then Step := 1;
WRect.Top := WRect.Bottom - Step;
M := (CRect.Bottom - CRect.Top) div (Step + 2);
if (CRect.Bottom - CRect.Top) mod (Step + 2) > 0 then
Inc(M);
end;
LogBruhs.lbStyle := BS_SOLID;
case AState of
pbsError: LogBruhs.lbColor := $0000FF;
pbsPaused: LogBruhs.lbColor := $00FFFF;
pbsPartial: LogBruhs.lbColor := $FF0000;
else LogBruhs.lbColor := GetSysColor(COLOR_HIGHLIGHT);
end;
LogBruhs.lbHatch := 0;
Brush := CreateBrushIndirect(LogBruhs);
try
OldBrush := SelectObject(ADC, Brush);
for i := 0 to M - 1 do
begin
FillRect(ADC, WRect, Brush);
if AHorizontal then
begin
WRect.Left := WRect.Left + Step + 2;
WRect.Right := WRect.Left + Step;
if WRect.Right > CRect0.Right then
WRect.Right := CRect0.Right;
end
else
begin
WRect.Bottom := WRect.Bottom - Step - 2;
WRect.Top := WRect.Bottom - Step;
if WRect.Top < CRect0.Top then
WRect.Top := CRect0.Top;
end;
end;
Brush := SelectObject(ADC, OldBrush);
finally
DeleteObject(Brush);
end;
end;
end;
end;
procedure DrawProgressBar(ADC: HDC; const ARect: TRect; AMin, AMax, APos: Integer;
AState: TProgressBarState = pbsNormal; AHorizontal: Boolean = True;
ADoubleBuffered: Boolean = True; ATransparent: Boolean = False);
var W, H: integer;
DC: HDC;
Bitmap, OldBitmap: HBITMAP;
begin
if ADoubleBuffered then
begin
with ARect do
begin
W := Right - Left;
H := Bottom - Top;
end;
with ARect do
Bitmap := CreateCompatibleBitmap(ADC, W, H);
if Bitmap <> 0 then
try
DC := CreateCompatibleDC(ADC);
if DC <> 0 then
try
OldBitmap := SelectObject(DC, Bitmap);
try
with ARect do
BitBlt(DC, 0, 0, W, H, ADC, Left, Top, SRCCOPY);
DrawProgressBar(DC, Rect(0, 0, W, H), AMin, AMax, APos, AState,
AHorizontal, False, ATransparent);
with ARect do
BitBlt(ADC, Left, Top, W, H, DC, 0, 0, SRCCOPY);
finally
SelectObject(DC, OldBitmap);
end;
finally
DeleteDC(DC);
end;
finally
DeleteObject(Bitmap);
end;
end
else
begin
if APos < AMin then APos := AMin;
if APos > AMax then APos := AMax;
if AMin >= AMax then AMin := AMax - 1;
InitUxTheme;
if UseThemes then
DrawProgressBarThemed(ADC, ARect, AMin, AMax, APos, AState, AHorizontal, ATransparent)
else
DrawProgressBarStandard(ADC, ARect, AMin, AMax, APos, AState, AHorizontal);
end;
end;
initialization
finalization
DoneUxTheme;
end.
Надеюсь, поможет.
