paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

patch by theo temporarily revert it is problematic on windows

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@87 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
christian_u 2007-02-25 21:29:19 +00:00
parent e8515ca089
commit 0a4411699c
1 changed files with 134 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

219
components/virtualtreeview/virtualtrees.pas
View File

@ -70,7 +70,7 @@ interface
{.$define UseLocalMemoryManager} {.$define UseLocalMemoryManager}
uses uses
LCLProc, LCLType, Types, LMessages, LCLIntf, SysUtils, Classes, opbitmap, lazbridge, Graphics, Controls, Forms, ImgList, {ActiveX,} StdCtrls, Menus, Printers, LCLProc, LCLType, Types, LMessages, LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, ImgList, {ActiveX,} StdCtrls, Menus, Printers,
LResources, GraphType, CustomTimer, LResources, GraphType, CustomTimer,
SyncObjs, // critical sections SyncObjs, // critical sections
CommCtrl // image lists, common controls tree structures CommCtrl // image lists, common controls tree structures
@ -849,7 +849,7 @@ type
function AdjustHoverColumn(P: TPoint): Boolean; function AdjustHoverColumn(P: TPoint): Boolean;
procedure AdjustPosition(Column: TVirtualTreeColumn; Position: Cardinal); procedure AdjustPosition(Column: TVirtualTreeColumn; Position: Cardinal);
procedure DrawButtonText(DC: HDC; Caption: WideString; Bounds: TRect; Enabled, Hot: Boolean; DrawFormat: Cardinal); procedure DrawButtonText(DC: HDC; Caption: WideString; Bounds: TRect; Enabled, Hot: Boolean; DrawFormat: Cardinal);
procedure DrawXPButton(Canvas: TCanvas; ButtonR: TRect; DrawSplitter, Down, Hover, HoverOnTop: Boolean); procedure DrawXPButton(DC: HDC; ButtonR: TRect; DrawSplitter, Down, Hover: Boolean);
procedure FixPositions; procedure FixPositions;
function GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: Integer; Relative: Boolean = True): Integer; function GetColumnAndBounds(P: TPoint; var ColumnLeft, ColumnRight: Integer; Relative: Boolean = True): Integer;
function GetOwner: TPersistent; override; function GetOwner: TPersistent; override;
@ -3166,7 +3166,7 @@ procedure DrawTextW(Canvas: TCanvas; lpString: PWideChar; var lpRect: TRect; uFo
var Style:TTextStyle; var Style:TTextStyle;
begin begin
{$ifndef WINCE} {$ifndef WINCE}
{$ifdef LCLGTK} {$ifdef LINUX}
Style.Layout:=tlCenter; Style.Layout:=tlCenter;
Canvas.TextRect(lpRect,lpRect.Left,lpRect.Top,lpString,Style); // theo 24.2.2007 Gibt sonst Striche auf GTK1 Canvas.TextRect(lpRect,lpRect.Left,lpRect.Top,lpString,Style); // theo 24.2.2007 Gibt sonst Striche auf GTK1
{$else} {$else}
@ -3733,7 +3733,6 @@ var
Dest: TRect; Dest: TRect;
//Small (???) hack while a solution does not come //Small (???) hack while a solution does not come
Stream: TMemoryStream; Stream: TMemoryStream;
TempOPB, SourceOPB:TCanvasOPBitmap;
begin begin
Watcher.Enter; Watcher.Enter;
try try
@ -3762,23 +3761,22 @@ begin
MaskColor := clFuchsia;//Images.Canvas.Pixels[0, 0]; // this is usually clFuchsia MaskColor := clFuchsia;//Images.Canvas.Pixels[0, 0]; // this is usually clFuchsia
Dest := Rect(0, 0, IL.Width, IL.Height); Dest := Rect(0, 0, IL.Width, IL.Height);
for I := 0 to (Images.Width div Images.Height) - 1 do
SourceOPB:=TCanvasOPBitmap.create; //theo 25.2.07
AssignBitmapToOpBitmap(Images,SourceOPB);
for I := 0 to (Images.Width div Images.Height) - 1 do
begin begin
Source := Rect(I * IL.Width, 0, (I + 1) * IL.Width, IL.Height); Source := Rect(I * IL.Width, 0, (I + 1) * IL.Width, IL.Height);
TempOPB:=TCanvasOPBitmap.create; OneImage:= TBitmap.Create;
TempOPB.Width:=IL.Height; OneImage.Width:=IL.Height;
TempOPB.Height:=IL.Width; OneImage.Height:=IL.Width;
TempOPB.Canvas.CopyRect(Dest, SourceOPB.Canvas, Source); OneImage.Canvas.CopyRect(Dest, Images.Canvas, Source);
TempOPB.TransparentColor:=MaskColor; //somehow SaveToStream - LoadFromStream restores the tranparency lost in CopyRect
OneImage.SaveToStream(Stream);
OneImage.Free;
AnotherImage:=TBitmap.Create; AnotherImage:=TBitmap.Create;
AssignOpBitmapToBitmap(TempOPB,AnotherImage); Stream.Position:=0;
TempOPB.free; AnotherImage.LoadFromStream(Stream);
Stream.Size:=0;
IL.AddDirect(AnotherImage, nil); IL.AddDirect(AnotherImage, nil);
end; end;
SourceOPB.free;
finally finally
Images.Free; Images.Free;
//OneImage.Free; //OneImage.Free;
@ -3878,8 +3876,8 @@ var
begin begin
{$IFDEF LINUX} //theo 24.2.2007 {$IFDEF LINUX} //theo 24.2.2007
Width:=16; Width:=14;
Height:=16; {$message warn'nur um die exception zu verhindern. Werte nicht getestet'} Height:=14; {$message warn'nur um die exception zu verhindern. Werte nicht getestet'}
{$ELSE} {$ELSE}
Width := GetSystemMetrics(SM_CXMENUCHECK) + 3; Width := GetSystemMetrics(SM_CXMENUCHECK) + 3;
Height := GetSystemMetrics(SM_CYMENUCHECK) + 3; Height := GetSystemMetrics(SM_CYMENUCHECK) + 3;
@ -7126,85 +7124,138 @@ const
XPDownMiddleLineColor = $B8C2C1; // Down state border color. XPDownMiddleLineColor = $B8C2C1; // Down state border color.
XPDownInnerLineColor = $C9D1D0; // Down state border color. XPDownInnerLineColor = $C9D1D0; // Down state border color.
procedure TVirtualTreeColumns.DrawXPButton(Canvas: TCanvas; ButtonR: TRect; DrawSplitter, Down, Hover, HoverOnTop: Boolean); procedure TVirtualTreeColumns.DrawXPButton(DC: HDC; ButtonR: TRect; DrawSplitter, Down, Hover: Boolean);
var
SavBrColor, SavPnColor, PenColor: TColor;
dRed, dGreen, dBlue: integer;
Y, dY: integer;
begin
SavBrColor:=Canvas.Brush.Color; // Helper procedure to draw an Windows XP like header button.
SavPnColor:=Canvas.Pen.Color;
if Down then var
Canvas.Brush.Color := XPMainHeaderColorDown PaintBrush: HBRUSH;
else if Hover then Pen,
Canvas.Brush.Color := XPMainHeaderColorHover OldPen: HPEN;
PenColor,
FillColor: COLORREF;
dRed, dGreen, dBlue: Single;
Width,
XPos: Integer;
begin
{ if Down then
FillColor := XPMainHeaderColorDown
else else
Canvas.Brush.Color := XPMainHeaderColorUp; if Hover then
Canvas.FillRect(ButtonR); FillColor := XPMainHeaderColorHover
Canvas.Brush.Color:=SavBrColor; else
FillColor := XPMainHeaderColorUp;
PaintBrush := CreateSolidBrush(FillColor);
FillRect(DC, ButtonR, PaintBrush);
DeleteObject(PaintBrush);
if DrawSplitter and not (Down or Hover) then if DrawSplitter and not (Down or Hover) then
begin begin
Canvas.Pen.Color:=XPDarkSplitBarColor; // One solid pen for the dark line...
Canvas.MoveTo(ButtonR.Right - 2, ButtonR.Top + 3); Pen := CreatePen(PS_SOLID, 1, XPDarkSplitBarColor);
Canvas.LineTo(ButtonR.Right - 2, ButtonR.Bottom - 5); OldPen := SelectObject(DC, Pen);
Canvas.Pen.Color:=XPLightSplitBarColor; MoveToEx(DC, ButtonR.Right - 2, ButtonR.Top + 3, nil);
Canvas.MoveTo(ButtonR.Right - 1, ButtonR.Top + 3); LineTo(DC, ButtonR.Right - 2, ButtonR.Bottom - 5);
Canvas.LineTo(ButtonR.Right - 1, ButtonR.Bottom - 5); // ... and one solid pen for the light line.
Pen := CreatePen(PS_SOLID, 1, XPLightSplitBarColor);
DeleteObject(SelectObject(DC, Pen));
MoveToEx(DC, ButtonR.Right - 1, ButtonR.Top + 3, nil);
LineTo(DC, ButtonR.Right - 1, ButtonR.Bottom - 5);
SelectObject(DC, OldPen);
DeleteObject(Pen);
end; end;
if Down then begin if Down then
Canvas.Pen.Color:=XPDownOuterLineColor; begin
Canvas.MoveTo(ButtonR.Left, ButtonR.Top); // Down state. Three lines to draw.
Canvas.LineTo(ButtonR.Left, ButtonR.Bottom - 1); // First one is the outer line, drawn at left, bottom and right.
Canvas.LineTo(ButtonR.Right - 1, ButtonR.Bottom - 1); Pen := CreatePen(PS_SOLID, 1, XPDownOuterLineColor);
Canvas.LineTo(ButtonR.Right - 1, ButtonR.Top - 1); OldPen := SelectObject(DC, Pen);
MoveToEx(DC, ButtonR.Left, ButtonR.Top, nil);
LineTo(DC, ButtonR.Left, ButtonR.Bottom - 1);
LineTo(DC, ButtonR.Right - 1, ButtonR.Bottom - 1);
LineTo(DC, ButtonR.Right - 1, ButtonR.Top - 1);
Canvas.Pen.Color:=XPDownMiddleLineColor; // Second one is the middle line, which is a bit lighter.
Canvas.MoveTo(ButtonR.Left + 1, ButtonR.Bottom - 2); Pen := CreatePen(PS_SOLID, 1, XPDownMiddleLineColor);
Canvas.LineTo(ButtonR.Left + 1, ButtonR.Top); DeleteObject(SelectObject(DC, Pen));
Canvas.LineTo(ButtonR.Right - 1, ButtonR.Top); MoveToEx(DC, ButtonR.Left + 1, ButtonR.Bottom - 2, nil);
LineTo(DC, ButtonR.Left + 1, ButtonR.Top);
LineTo(DC, ButtonR.Right - 1, ButtonR.Top);
Canvas.Pen.Color:=XPDownInnerLineColor; // Third line is the inner line, which is even lighter than the middle line.
Canvas.MoveTo(ButtonR.Left + 2, ButtonR.Bottom - 2); Pen := CreatePen(PS_SOLID, 1, XPDownInnerLineColor);
Canvas.LineTo(ButtonR.Left + 2, ButtonR.Top + 1); DeleteObject(SelectObject(DC, Pen));
Canvas.LineTo(ButtonR.Right - 1, ButtonR.Top + 1); MoveToEx(DC, ButtonR.Left + 2, ButtonR.Bottom - 2, nil);
LineTo(DC, ButtonR.Left + 2, ButtonR.Top + 1);
LineTo(DC, ButtonR.Right - 1, ButtonR.Top + 1);
// Housekeeping:
SelectObject(DC, OldPen);
DeleteObject(Pen);
end end
else if Hover then begin else
//DrawXPHover(Canvas, ButtonR, HoverOnTop); if Hover then
end begin
else begin // Hover state. There are three lines at the bottom border, but they are rendered in a way which
if HoverOnTop then begin // requires expensive construction.
Y:=ButtonR.Top; Width := ButtonR.Right - ButtonR.Left;
dY:=1; if Width <= 32 then
begin
ImageList_DrawEx(UtilityImages.Handle, 8, DC, ButtonR.Right - 16, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE,
ILD_NORMAL);
ImageList_DrawEx(UtilityImages.Handle, 6, DC, ButtonR.Left, ButtonR.Bottom - 3, Width div 2, 3, CLR_NONE,
CLR_NONE, ILD_NORMAL);
end
else
begin
ImageList_DrawEx(UtilityImages.Handle, 6, DC, ButtonR.Left, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE,
ILD_NORMAL);
// Replicate inner part as many times as need to fill up the button rectangle.
XPos := ButtonR.Left + 16;
repeat
ImageList_DrawEx(UtilityImages.Handle, 7, DC, XPos, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE, ILD_NORMAL);
Inc(XPos, 16);
until XPos + 16 >= ButtonR.Right;
ImageList_DrawEx(UtilityImages.Handle, 8, DC, ButtonR.Right - 16, ButtonR.Bottom - 3, 16, 3, CLR_NONE, CLR_NONE,
ILD_NORMAL);
end;
end end
else begin else
Y:=ButtonR.Bottom-1; begin
dY:=-1; // There is a three line gradient near the bottom border which transforms from the button color to a dark,
end; // clBtnFace like color (here XPDarkGradientColor).
PenColor := XPMainHeaderColorUp; PenColor := XPMainHeaderColorUp;
dRed := ((PenColor and $FF) - (XPDarkGradientColor and $FF)) div 3; dRed := ((PenColor and $FF) - (XPDarkGradientColor and $FF)) / 3;
dGreen := (((PenColor shr 8) and $FF) - ((XPDarkGradientColor shr 8) and $FF)) div 3; dGreen := (((PenColor shr 8) and $FF) - ((XPDarkGradientColor shr 8) and $FF)) / 3;
dBlue := (((PenColor shr 16) and $FF) - ((XPDarkGradientColor shr 16) and $FF)) div 3; dBlue := (((PenColor shr 16) and $FF) - ((XPDarkGradientColor shr 16) and $FF)) / 3;
PenColor := PenColor - Lo(dRed) - Lo(dGreen) shl 8 - Lo(dBlue) shl 16; // First line:
Canvas.Pen.Color:=PenColor; PenColor := PenColor - Round(dRed) - Round(dGreen) shl 8 - Round(dBlue) shl 16;
Canvas.MoveTo(ButtonR.Left, Y + 2*dY); Pen := CreatePen(PS_SOLID, 1, PenColor);
Canvas.LineTo(ButtonR.Right, Y + 2*dY); OldPen := SelectObject(DC, Pen);
MoveToEx(DC, ButtonR.Left, ButtonR.Bottom - 3, nil);
LineTo(DC, ButtonR.Right, ButtonR.Bottom - 3);
Canvas.Pen.Color := PenColor - Lo(dRed) - Lo(dGreen) shl 8 - Lo(dBlue) shl 16; // Second line:
Canvas.MoveTo(ButtonR.Left, Y + dY); PenColor := PenColor - Round(dRed) - Round(dGreen) shl 8 - Round(dBlue) shl 16;
Canvas.LineTo(ButtonR.Right, Y + dY); Pen := CreatePen(PS_SOLID, 1, PenColor);
DeleteObject(SelectObject(DC, Pen));
MoveToEx(DC, ButtonR.Left, ButtonR.Bottom - 2, nil);
LineTo(DC, ButtonR.Right, ButtonR.Bottom - 2);
Canvas.Pen.Color := XPDarkGradientColor; // Third line:
Canvas.MoveTo(ButtonR.Left, Y); Pen := CreatePen(PS_SOLID, 1, XPDarkGradientColor);
Canvas.LineTo(ButtonR.Right, Y); DeleteObject(SelectObject(DC, Pen));
end; MoveToEx(DC, ButtonR.Left, ButtonR.Bottom - 1, nil);
Canvas.Pen.Color:=SavPnColor; LineTo(DC, ButtonR.Right, ButtonR.Bottom - 1);
// Housekeeping:
DeleteObject(SelectObject(DC, OldPen));
end; }
end; end;
//---------------------------------------------------------------------------------------------------------------------- //----------------------------------------------------------------------------------------------------------------------
procedure TVirtualTreeColumns.FixPositions; procedure TVirtualTreeColumns.FixPositions;
@ -7996,8 +8047,7 @@ begin
else else
{$endif ThemeSupport} {$endif ThemeSupport}
if FHeader.Style = hsXPStyle then if FHeader.Style = hsXPStyle then
// DrawXPButton(Handle, Run, False, False, False) DrawXPButton(Handle, Run, False, False, False)
DrawXPButton(PaintInfo.TargetCanvas, Run, False, False, False, False)
else else
begin begin
Brush.Color := FHeader.FBackground; Brush.Color := FHeader.FBackground;
@ -8083,8 +8133,7 @@ begin
{$endif ThemeSupport} {$endif ThemeSupport}
begin begin
if FHeader.Style = hsXPStyle then if FHeader.Style = hsXPStyle then
// DrawXPButton(Handle, PaintRectangle, RightBorderFlag <> 0, IsDownIndex, IsHoverIndex) DrawXPButton(Handle, PaintRectangle, RightBorderFlag <> 0, IsDownIndex, IsHoverIndex)
DrawXPButton(PaintInfo.TargetCanvas, PaintRectangle, RightBorderFlag <> 0, IsDownIndex, IsHoverIndex, False)
else else
if IsDownIndex then if IsDownIndex then
DrawEdge(Handle, PaintRectangle, PressedButtonStyle, PressedButtonFlags) DrawEdge(Handle, PaintRectangle, PressedButtonStyle, PressedButtonFlags)