pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Make compatible to actual svn, Mac OSX Compatibility

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@253 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
christian_u
2007-09-02 19:04:07 +00:00
parent 5d38e0badc
commit 55d828ec76
4 changed files with 88 additions and 6354 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
components/virtualtreeview/virtualstringtree.pas
View File

@ -1570,8 +1570,8 @@ var
R: TRect;
S: WideString;
DrawFormat: Cardinal;
xxBidiMode: TBidiMode;
// xAlignment: TAlignment;
xBidiMode: Classes.TBidiMode;
xAlignment: TAlignment;
PaintInfo: TVTPaintInfo;
Dummy: TColumnIndex;
@ -1584,28 +1584,28 @@ begin
DrawFormat := DT_TOP or DT_NOPREFIX or DT_CALCRECT or DT_WORDBREAK;
if Column <= NoColumn then
begin
//b BidiMode := Self.BidiMode;
// xAlignment := Self.Alignment;
xBidiMode := Self.BidiMode;
xAlignment := Self.Alignment;
end
else
begin
//b BidiMode := Header.Columns[Column].BidiMode;
// xAlignment := Header.Columns[Column].Alignment;
BidiMode := Header.Columns[Column].BidiMode;
xAlignment := Header.Columns[Column].Alignment;
end;
//b if BidiMode <> bdLeftToRight then
//b ChangeBidiModeAlignment(Alignment);
// if xBidiMode <> bdLeftToRight then
// ChangeBidiModeAlignment(Alignment);
// Allow for autospanning.
PaintInfo.Node := Node;
//b PaintInfo.BidiMode := BidiMode;
PaintInfo.BidiMode := xBidiMode;
PaintInfo.Column := Column;
PaintInfo.CellRect := R;
AdjustPaintCellRect(PaintInfo, Dummy);
//b if BidiMode <> bdLeftToRight then
//b DrawFormat := DrawFormat or DT_RIGHT or DT_RTLREADING
//b else
if xBidiMode <> bdLeftToRight then
DrawFormat := DrawFormat or DT_RIGHT or DT_RTLREADING
else
DrawFormat := DrawFormat or DT_LEFT;
DrawTextW(xCanvas, PWideChar(S), PaintInfo.CellRect, DrawFormat, False); //theo
Result := PaintInfo.CellRect.Bottom - PaintInfo.CellRect.Top;

155
components/virtualtreeview/virtualtrees.pas
View File

@ -193,9 +193,6 @@ var // Clipboard format IDs used in OLE drag'n drop and clipboard transfers.
{$MinEnumSize 1, make enumerations as small as possible}
type
// later: remove, only now a dummy
TBidiMode = Byte;
// The exception used by the trees.
EVirtualTreeError = class(Exception);
@ -615,7 +612,7 @@ type
DefaultHint: WideString; // used only if there is no node specific hint string available
// or a header hint is about to appear
HintText: WideString; // set when size of the hint window is calculated
//b BidiMode: TBidiMode;
BidiMode: TBidiMode;
Alignment: TAlignment;
end;
@ -741,7 +738,7 @@ type
FMaxWidth: Integer;
FStyle: TVirtualTreeColumnStyle;
FImageIndex: TImageIndex;
//b FBiDiMode: TBiDiMode;
FBiDiMode: TBiDiMode;
FLayout: TVTHeaderColumnLayout;
FMargin,
FSpacing: Integer;
@ -755,7 +752,7 @@ type
function IsBiDiModeStored: Boolean;
function IsColorStored: Boolean;
procedure SetAlignment(const Value: TAlignment);
//b procedure SetBiDiMode(Value: TBiDiMode);
procedure SetBiDiMode(Value: TBiDiMode);
procedure SetColor(const Value: TColor);
procedure SetImageIndex(Value: TImageIndex);
procedure SetLayout(Value: TVTHeaderColumnLayout);
@ -798,7 +795,7 @@ type
property Owner: TVirtualTreeColumns read GetOwner;
published
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
//b property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored default bdLeftToRight;
property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored default bdLeftToRight;
property Color: TColor read FColor write SetColor stored IsColorStored default clWindow;
property Hint: WideString read FHint write FHint stored False;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
@ -1320,7 +1317,7 @@ type
ContentRect: TRect; // the area of the cell used for the node's content
NodeWidth: Integer; // the actual node width
Alignment: TAlignment; // how to align within the node rectangle
//b BidiMode: TBidiMode; // directionality to be used for painting
BidiMode: TBidiMode; // directionality to be used for painting
BrushOrigin: TPoint; // the alignment for the brush used to draw dotted lines
ImageInfo: array[TVTImageInfoIndex] of TVTImageInfo; // info about each possible node image
end;
@ -3166,7 +3163,11 @@ procedure DrawTextW(Canvas: TCanvas; lpString: PWideChar; var lpRect: TRect; uFo
var Style:TTextStyle;
begin
{$ifndef WINCE}
<<<<<<< .mine
{$ifdef UNIX}
=======
{$ifdef LCLgtk}
>>>>>>> .r252
Style.Layout:=tlCenter;
Canvas.TextRect(lpRect,lpRect.Left,lpRect.Top,lpString,Style); // theo 24.2.2007 Gibt sonst Striche auf GTK1
{$else}
@ -3795,7 +3796,7 @@ begin
Stream.Position:=0;
AnotherImage.LoadFromStream(Stream);
Stream.Size:=0;
IL.AddDirect(AnotherImage, nil);
IL.Add(AnotherImage, nil);
end;
}
finally
@ -3846,8 +3847,7 @@ var
FlatImages.Draw(BM.Canvas, OffsetX, OffsetY, I)
else
DarkCheckImages.Draw(BM.Canvas, OffsetX, OffsetY, I);
//IL.AddMasked(BM, MaskColor);
IL.AddCopy(BM,nil);
IL.AddMasked(BM, MaskColor);
end;
end;
@ -3885,8 +3885,7 @@ var
ButtonState := ButtonState or DFCS_FLAT;
//todo: remap to LCLIntf
// DrawFrameControl(BM.Canvas.Handle, Rect(1, 2, BM.Width - 2, BM.Height - 1), DFC_BUTTON, ButtonType or ButtonState);
IL.AddCopy(BM,nil);
//IL.AddMasked(BM, MaskColor);
IL.AddMasked(BM, MaskColor);
end;
//--------------- end local functions ---------------------------------------
@ -3896,7 +3895,7 @@ var
begin
{$IFDEF LINUX} //theo 24.2.2007
{$IFDEF UNIX} //theo 24.2.2007
Width:=16;
Height:=16; {$message warn'nur um die exception zu verhindern. Werte nicht getestet'}
{$ELSE}
@ -3919,8 +3918,7 @@ begin
BM.Canvas.Brush.Color := MaskColor;
BM.Canvas.Brush.Style := bsSolid;
BM.Canvas.FillRect(Rect(0, 0, BM.Width, BM.Height));
//IL.AddMasked(BM, MaskColor);
IL.AddCopy(BM,nil);
IL.AddMasked(BM, MaskColor);
// Add the 20 system checkbox and radiobutton images.
for I := 0 to 19 do
@ -4972,12 +4970,12 @@ begin
// Determine text position and don't forget the border.
InflateRect(R, -Tree.FTextMargin - 1, -1);
DrawFormat := DT_TOP or DT_NOPREFIX;
//b if BidiMode <> bdLeftToRight then
//b begin
//b DrawFormat := DrawFormat or DT_RIGHT or DT_RTLREADING;
//b Inc(R.Right);
//b end
//b else
if BidiMode <> bdLeftToRight then
begin
DrawFormat := DrawFormat or DT_RIGHT or DT_RTLREADING;
Inc(R.Right);
end
else
DrawFormat := DrawFormat or DT_LEFT;
SetBkMode(Handle, LCLType.TRANSPARENT);
R.Top := Y;
@ -5207,7 +5205,7 @@ begin
// The text alignment is based on the bidi mode passed in the hint data, hence we can
// simply set the window's mode to left-to-right (it might have been modified by the caller, if the
// tree window is right-to-left aligned).
//b BidiMode := bdLeftToRight;
BidiMode := bdLeftToRight;
FHintData := PVTHintData(AData)^;
@ -5221,17 +5219,17 @@ begin
begin
if Column <= NoColumn then
begin
//b BidiMode := Tree.BidiMode;
BidiMode := Tree.BidiMode;
Alignment := Tree.Alignment;
end
else
begin
//b BidiMode := Tree.Header.Columns[Column].BidiMode;
BidiMode := Tree.Header.Columns[Column].BidiMode;
Alignment := Tree.Header.Columns[Column].Alignment;
end;
//b if BidiMode <> bdLeftToRight then
//b ChangeBidiModeAlignment(Alignment);
// if BidiMode <> bdLeftToRight then
// ChangeBidiModeAlignment(Alignment);
if (Node = nil) or (Tree.FHintMode <> hmToolTip) then
begin
@ -5899,7 +5897,7 @@ begin
FText := '';
FOptions := DefaultColumnOptions;
FAlignment := taLeftJustify;
//b FBidiMode := bdLeftToRight;
FBidiMode := bdLeftToRight;
FColor := clWindow;
FLayout := blGlyphLeft;
@ -6011,8 +6009,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
{bprocedure TVirtualTreeColumn.SetBiDiMode(Value: TBiDiMode);
procedure TVirtualTreeColumn.SetBiDiMode(Value: TBiDiMode);
begin
if Value <> FBiDiMode then
begin
@ -6022,7 +6019,7 @@ begin
// Setting the alignment affects also the tree, hence invalidate it too.
Owner.Header.TreeView.Invalidate;
end;
end;}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -6340,12 +6337,12 @@ begin
taLeftJustify:
begin
MinLeft := FMargin;
//b if UseSortGlyph and (FBidiMode <> bdLeftToRight) then
//b begin
//b // In RTL context is the sort glyph placed on the left hand side.
//b SortGlyphPos.X := MinLeft;
//b Inc(MinLeft, SortGlyphSize.X + FSpacing);
//b end;
if UseSortGlyph and (FBidiMode <> bdLeftToRight) then
begin
// In RTL context is the sort glyph placed on the left hand side.
SortGlyphPos.X := MinLeft;
Inc(MinLeft, SortGlyphSize.X + FSpacing);
end;
if Layout in [blGlyphTop, blGlyphBottom] then
begin
// Header glyph is above or below text, so both must be considered when calculating
@ -6378,8 +6375,8 @@ begin
Inc(MinLeft, HeaderGlyphSize.X + FSpacing);
end;
end;
//b if UseSortGlyph and (FBidiMode = bdLeftToRight) then
//b SortGlyphPos.X := MinLeft;
if UseSortGlyph and (FBidiMode = bdLeftToRight) then
SortGlyphPos.X := MinLeft;
end;
taCenter:
begin
@ -6415,27 +6412,27 @@ begin
end;
// Place the sort glyph directly to the left or right of the larger item.
if UseSortGlyph then
//b if FBidiMode = bdLeftToRight then
//b begin
//b // Sort glyph on the right hand side.
//b SortGlyphPos.X := MaxRight + FSpacing;
//b end
//b else
//b begin
if FBidiMode = bdLeftToRight then
begin
// Sort glyph on the right hand side.
SortGlyphPos.X := MaxRight + FSpacing;
end
else
begin
// Sort glyph on the left hand side.
SortGlyphPos.X := MinLeft - FSpacing - SortGlyphSize.X;
//b end;
end;
end;
else
// taRightJustify
MaxRight := ClientSize.X - FMargin;
//b if UseSortGlyph and (FBidiMode = bdLeftToRight) then
//b begin
//b // In LTR context is the sort glyph placed on the right hand side.
//b Dec(MaxRight, SortGlyphSize.X);
//b SortGlyphPos.X := MaxRight;
//b Dec(MaxRight, FSpacing);
//b end;
if UseSortGlyph and (FBidiMode = bdLeftToRight) then
begin
// In LTR context is the sort glyph placed on the right hand side.
Dec(MaxRight, SortGlyphSize.X);
SortGlyphPos.X := MaxRight;
Dec(MaxRight, FSpacing);
end;
if Layout in [blGlyphTop, blGlyphBottom] then
begin
TextPos.X := MaxRight - TextSize.cx;
@ -6466,8 +6463,8 @@ begin
MaxRight := HeaderGlyphPos.X - FSpacing;
end;
end;
//b if UseSortGlyph and (FBidiMode <> bdLeftToRight) then
//b SortGlyphPos.X := MaxRight - SortGlyphSize.X;
if UseSortGlyph and (FBidiMode <> bdLeftToRight) then
SortGlyphPos.X := MaxRight - SortGlyphSize.X;
end;
end;
@ -6480,20 +6477,20 @@ begin
MaxRight := ClientSize.X - FMargin;
if UseSortGlyph then
begin
//b if FBidiMode = bdLeftToRight then
//b begin
//b // Sort glyph on the right hand side.
//b if SortGlyphPos.X + SortGlyphSize.X > MaxRight then
//b SortGlyphPos.X := MaxRight - SortGlyphSize.X;
//b MaxRight := SortGlyphPos.X - FSpacing;
//b end;
if FBidiMode = bdLeftToRight then
begin
// Sort glyph on the right hand side.
if SortGlyphPos.X + SortGlyphSize.X > MaxRight then
SortGlyphPos.X := MaxRight - SortGlyphSize.X;
MaxRight := SortGlyphPos.X - FSpacing;
end;
// Consider also the left side of the sort glyph regardless of the bidi mode.
if SortGlyphPos.X < MinLeft then
SortGlyphPos.X := MinLeft;
// Left border needs only adjustment if the sort glyph marks the left border.
//b if FBidiMode <> bdLeftToRight then
//b MinLeft := SortGlyphPos.X + SortGlyphSize.X + FSpacing;
if FBidiMode <> bdLeftToRight then
MinLeft := SortGlyphPos.X + SortGlyphSize.X + FSpacing;
// Finally transform sort glyph to its actual position.
with SortGlyphPos do
@ -6658,7 +6655,7 @@ begin
OldOptions := FOptions;
FOptions := [];
//b BiDiMode := TVirtualTreeColumn(Source).BiDiMode;
BiDiMode := TVirtualTreeColumn(Source).BiDiMode;
ImageIndex := TVirtualTreeColumn(Source).ImageIndex;
Layout := TVirtualTreeColumn(Source).Layout;
Margin := TVirtualTreeColumn(Source).Margin;
@ -6689,7 +6686,7 @@ end;
function TVirtualTreeColumn.Equals(OtherColumn: TVirtualTreeColumn): Boolean;
begin
Result := {b(BiDiMode = OtherColumn.BiDiMode) and}
Result := (BiDiMode = OtherColumn.BiDiMode) and
(ImageIndex = OtherColumn.ImageIndex) and
(Layout = OtherColumn.Layout) and
(Margin = OtherColumn.Margin) and
@ -6780,7 +6777,7 @@ begin
ReadBuffer(Dummy, SizeOf(Dummy));
Spacing := Dummy;
ReadBuffer(Dummy, SizeOf(Dummy));
//b BiDiMode := TBiDiMode(Dummy);
BiDiMode := TBiDiMode(Dummy);
ReadBuffer(Dummy, SizeOf(Dummy));
Options := ConvertOptions(Dummy);
@ -6813,9 +6810,9 @@ begin
if coParentBiDiMode in FOptions then
begin
Columns := GetOwner as TVirtualTreeColumns;
if Assigned(Columns) {band (FBidiMode <> Columns.FHeader.Treeview.BiDiMode)} then
if Assigned(Columns) and (FBidiMode <> Columns.FHeader.Treeview.BiDiMode) then
begin
//b FBiDiMode := Columns.FHeader.Treeview.BiDiMode;
FBiDiMode := Columns.FHeader.Treeview.BiDiMode;
Changed(False);
end;
end;
@ -6875,8 +6872,8 @@ begin
WriteBuffer(Dummy, SizeOf(Dummy));
WriteBuffer(FMargin, SizeOf(FMargin));
WriteBuffer(FSpacing, SizeOf(FSpacing));
//b Dummy := Ord(FBiDiMode);
//b WriteBuffer(Dummy, SizeOf(Dummy));
Dummy := Ord(FBiDiMode);
WriteBuffer(Dummy, SizeOf(Dummy));
//todo Dummy := Word(FOptions);
// WriteBuffer(Dummy, SizeOf(Dummy));
@ -6896,7 +6893,7 @@ end;
function TVirtualTreeColumn.UseRightToLeftReading: Boolean;
begin
//b Result := FBiDiMode <> bdLeftToRight;
Result := FBiDiMode <> bdLeftToRight;
Result := False;
end;
@ -7987,8 +7984,8 @@ begin
// Consider right-to-left directionality.
with FHeader.Treeview do
//b if (BidiMode <> bdLeftToRight) and (Integer(FRangeY) > ClientHeight) then
//b Inc(HOffset, GetSystemMetrics(SM_CXVSCROLL));
if (BidiMode <> bdLeftToRight) and (Integer(FRangeY) > ClientHeight) then
Inc(HOffset, GetSystemMetrics(SM_CXVSCROLL));
// Erase background of the header.
// See if the application wants to do that on its own.
@ -24085,7 +24082,7 @@ begin
ImageInfo[iiCheck].Index := GetCheckImage(Node);
if ImageInfo[iiCheck].Index > -1 then
begin
AdjustImageBorder(FCheckImages, 0, VAlign, ContentRect, ImageInfo[iiCheck]);
AdjustImageBorder(FCheckImages, BidiMode, VAlign, ContentRect, ImageInfo[iiCheck]);
ImageInfo[iiCheck].Ghosted := False;
end;
end
@ -24095,7 +24092,7 @@ begin
begin
ImageInfo[iiState].Index := GetImageIndex(Node, ikState, Column, ImageInfo[iiState].Ghosted);
if ImageInfo[iiState].Index > -1 then
AdjustImageBorder(FStateImages, 0, VAlign, ContentRect, ImageInfo[iiState]);
AdjustImageBorder(FStateImages, BidiMode, VAlign, ContentRect, ImageInfo[iiState]);
end
else
ImageInfo[iiState].Index := -1;
@ -24104,7 +24101,7 @@ begin
ImageInfo[iiNormal].Index := GetImageIndex(Node, ImageKind[vsSelected in Node^.States], Column,
ImageInfo[iiNormal].Ghosted);
if ImageInfo[iiNormal].Index > -1 then
AdjustImageBorder(FImages, 0, VAlign, ContentRect, ImageInfo[iiNormal]);
AdjustImageBorder(FImages, BidiMode, VAlign, ContentRect, ImageInfo[iiNormal]);
end
else
ImageInfo[iiNormal].Index := -1;
@ -24169,7 +24166,7 @@ begin
if (toShowButtons in FOptions.FPaintOptions) and (vsHasChildren in Node^.States) and
not ((vsAllChildrenHidden in Node^.States) and
(toAutoHideButtons in TreeOptions.FAutoOptions)) then
PaintNodeButton(Canvas, Node, CellRect, ButtonX, ButtonY, 0);
PaintNodeButton(Canvas, Node, CellRect, ButtonX, ButtonY, BidiMode);
if ImageInfo[iiCheck].Index > -1 then
PaintCheckImage(PaintInfo);

450
components/virtualtreeview/vt_lazbridge.pas
View File

@ -1,450 +0,0 @@
unit vt_lazbridge;
{ *************************************************************************** }
{ Copyright (c) 2007 Theo Lustenberger }
{ }
{ This software is provided "as-is". This software comes without warranty }
{ or garantee, explicit or implied. Use this software at your own risk. }
{ The author will not be liable for any damage to equipment, data, or }
{ information that may result while using this software. }
{ }
{ By using this software, you agree to the conditions stated above. }
{ *************************************************************************** }
{$MODE objfpc}{$H+}
{$DEFINE VER_VTV} //Version for VTV.
interface
uses Classes, SysUtils, Graphics, GraphType, InterfaceBase, LCLType,
IntfGraphics, FPimage, LCLIntf, ExtDlgs, FileUtil, ExtCtrls,
vt_opbitmap {$IFNDEF VER_VTV} , opbitmapformats {$ENDIF};
type
{ TMyIntfImage }
TMyIntfImage = class(TLazIntfImage)
public
procedure CreateBitmapLateMask(var Bitmap, MaskBitmap: HBitmap;
AlwaysCreateMask: boolean; const RawImage: TRawImage);
end;
{ TOPOpenDialog }
{$IFNDEF VER_VTV}
TOPOpenDialog = class(TOpenPictureDialog)
private
FPreviewFilename: string;
protected
procedure UpdatePreview; override;
function Execute: boolean; override;
end;
{ TLazOPPicture }
TLazOPPicture=class(TOPPicture)
private
fImage:TImage;
fUpdateImageSize:Boolean;
public
constructor Create(Image:TImage);
procedure DrawImage;
property UpdateImageSize:Boolean read fUpdateImageSize write fUpdateImageSize;
end;
{$ENDIF}
procedure AssignBitmapToOpBitmap(Bitmap: TBitmap; OpBitmap: TOpBitmap);
procedure AssignOpBitmapToBitmap(SourceBitmap: TOpBitmap; Bitmap: TBitmap; PreserveFormat: boolean = true);
procedure AssignOpBitmapToCanvas(OpBitmap: TOpBitmap; aCanvas: Graphics.TCanvas; X, Y: integer);
implementation
procedure AssignBitmapToOpBitmap(Bitmap: TBitmap; OpBitmap: TOpBitmap);
var int: TLazIntfImage;
i: integer;
x, y: integer;
begin
int := Bitmap.CreateIntfImage;
OpBitmap.Width := int.Width;
OpBitmap.Height := int.Height;
OpBitmap.Pixelformat := PixelFormatFromBPP(Int.DataDescription.BitsPerPixel);
for y := 0 to OpBitmap.Height - 1 do
for x := 0 to OpBitmap.Width - 1 do
OpBitmap.Pixels[X, Y] := Int.TColors[X, Y];
if Bitmap.Transparent then
OpBitmap.TransparentColor := Bitmap.TransparentColor else OPBitmap.Transparent:=false;
end;
procedure AssignOpBitmapToBitmap(SourceBitmap: TOpBitmap; Bitmap: TBitmap; PreserveFormat: boolean = true);
var int: TMyIntfImage;
var bmph, mbmph: HBitmap;
x, y: integer;
pmask: PByte;
rawi: TRawImage;
OPBitmap: TOpBitmap;
begin
if PreserveFormat then
begin
OpBitmap := TOPBitmap.create;
OpBitmap.Assign(SourceBitmap);
end else OpBitmap := SourceBitmap;
Int := TMyIntfImage.Create(0, 0);
Int.AutoCreateMask := false;
Int.GetDescriptionFromDevice(0);
Int.Width := OpBitmap.Width;
Int.Height := OpBitmap.Height;
OpBitmap.Pixelformat := PixelFormatFromBPP(Int.DataDescription.BitsPerPixel);
for y := 0 to OpBitmap.Height - 1 do
for x := 0 to OpBitmap.Width - 1 do
Int.TColors[X, Y] := OpBitmap.Pixels[X, Y];
if OPBitmap.Transparent then
begin
int.GetRawImage(Rawi);
rawi.MaskSize := OpBitmap.GetTransparentMask(0, pmask,
Rawi.Description.AlphaBitOrder = riboReversedBits,
TOPRawImageLineEnd(Rawi.Description.AlphaLineEnd));
rawi.Mask := pmask;
(* writeln(RawImageDescriptionAsString(@Rawi));
writeln('bwid: ',OpBitmap.Width, ' bhei: ',OpBitmap.Height,' rmsiz:',Rawi.MaskSize); *)
Int.CreateBitmapLateMask(bmph, mbmph, false, rawi);
end else
begin
Int.CreateBitmap(bmph, mbmph, false);
end;
Bitmap.Free;
Bitmap := TBitmap.Create;
Bitmap.Handle := bmph;
Bitmap.MaskHandle := mbmph;
Int.free;
if PreserveFormat then OPBitmap.free;
end;
procedure AssignOpBitmapToCanvas(OpBitmap: TOpBitmap; aCanvas: Graphics.TCanvas; X, Y: integer);
var Bmp: TBitmap;
begin
Bmp := TBitmap.create;
AssignOpBitmapToBitmap(OpBitmap, Bmp);
aCanvas.Draw(X, Y, bmp);
Bmp.free;
end;
{$IFNDEF VER_VTV}
{ TOPOpenDialog }
procedure TOPOpenDialog.UpdatePreview;
var
CurFilename: string;
FileIsValid: boolean;
OP: TOPPicture;
LBPP: Integer;
begin
CurFilename := FileName;
if CurFilename = FPreviewFilename then exit;
FPreviewFilename := CurFilename;
FileIsValid := FileExists(FPreviewFilename)
and (not DirPathExists(FPreviewFilename))
and FileIsReadable(FPreviewFilename);
if FileIsValid then
try
OP := TOPPicture.create;
try
OP.LoadFromFile(FPreviewFilename);
LBPP := OP.Bitmap.BPP;
OP.Bitmap.Transparent := false;
AssignOpBitmapToBitmap(Op.Bitmap, ImageCtrl.Picture.Bitmap, false);
PictureGroupBox.Caption := Format('(%dx%d BPP:%d)',
[ImageCtrl.Picture.Width, ImageCtrl.Picture.Height, LBPP]);
finally
OP.free;
end;
except
FileIsValid := False;
end;
if not FileIsValid then
ClearPreview;
end;
function TOPOpenDialog.Execute: boolean;
begin
Filter := OPGLoadFilters;
result := inherited Execute;
end;
{$ENDIF}
{ TMyIntfImage }
procedure TMyIntfImage.CreateBitmapLateMask(var Bitmap, MaskBitmap: HBitmap;
AlwaysCreateMask: boolean; const RawImage: TRawImage);
var
ARawImage: TRawImage;
begin
GetRawImage(ARawImage);
ARawImage.Mask := RawImage.Mask;
ARawImage.MaskSize := RawImage.MaskSize;
if not CreateBitmapFromRawImage(ARawImage, Bitmap, MaskBitmap, AlwaysCreateMask)
then
raise FPImageException.Create('Failed to create bitmaps');
end;
{$IFNDEF VER_VTV}
{ TLazOPPicture }
constructor TLazOPPicture.Create(Image: TImage);
begin
inherited Create;
fImage:=Image;
fUpdateImageSize:=true;
end;
procedure TLazOPPicture.DrawImage;
begin
if fImage<>nil then
begin
if fUpdateImageSize then fImage.SetBounds(0,0,Bitmap.Width,Bitmap.Height);
AssignOpBitmapToBitmap(Bitmap, fImage.Picture.Bitmap);
fImage.invalidate;
end;
end;
{$ENDIF}
end.
unit lazbridge;
{ *************************************************************************** }
{ Copyright (c) 2007 Theo Lustenberger }
{ }
{ This software is provided "as-is". This software comes without warranty }
{ or garantee, explicit or implied. Use this software at your own risk. }
{ The author will not be liable for any damage to equipment, data, or }
{ information that may result while using this software. }
{ }
{ By using this software, you agree to the conditions stated above. }
{ *************************************************************************** }
{$MODE objfpc}{$H+}
{$DEFINE VER_VTV} //Version for VTV.
interface
uses Classes, SysUtils, Graphics, GraphType, InterfaceBase, LCLType,
IntfGraphics, FPimage, LCLIntf, ExtDlgs, FileUtil, ExtCtrls,
opbitmap {$IFNDEF VER_VTV} , opbitmapformats {$ENDIF};
type
{ TMyIntfImage }
TMyIntfImage = class(TLazIntfImage)
public
procedure CreateBitmapLateMask(var Bitmap, MaskBitmap: HBitmap;
AlwaysCreateMask: boolean; const RawImage: TRawImage);
end;
{ TOPOpenDialog }
{$IFNDEF VER_VTV}
TOPOpenDialog = class(TOpenPictureDialog)
private
FPreviewFilename: string;
protected
procedure UpdatePreview; override;
function Execute: boolean; override;
end;
{ TLazOPPicture }
TLazOPPicture=class(TOPPicture)
private
fImage:TImage;
fUpdateImageSize:Boolean;
public
constructor Create(Image:TImage);
procedure DrawImage;
property UpdateImageSize:Boolean read fUpdateImageSize write fUpdateImageSize;
end;
{$ENDIF}
procedure AssignBitmapToOpBitmap(Bitmap: TBitmap; OpBitmap: TOpBitmap);
procedure AssignOpBitmapToBitmap(SourceBitmap: TOpBitmap; Bitmap: TBitmap; PreserveFormat: boolean = true);
procedure AssignOpBitmapToCanvas(OpBitmap: TOpBitmap; aCanvas: Graphics.TCanvas; X, Y: integer);
implementation
procedure AssignBitmapToOpBitmap(Bitmap: TBitmap; OpBitmap: TOpBitmap);
var int: TLazIntfImage;
i: integer;
x, y: integer;
begin
int := Bitmap.CreateIntfImage;
OpBitmap.Width := int.Width;
OpBitmap.Height := int.Height;
OpBitmap.Pixelformat := PixelFormatFromBPP(Int.DataDescription.BitsPerPixel);
for y := 0 to OpBitmap.Height - 1 do
for x := 0 to OpBitmap.Width - 1 do
OpBitmap.Pixels[X, Y] := Int.TColors[X, Y];
if Bitmap.Transparent then
OpBitmap.TransparentColor := Bitmap.TransparentColor;
end;
procedure AssignOpBitmapToBitmap(SourceBitmap: TOpBitmap; Bitmap: TBitmap; PreserveFormat: boolean = true);
var int: TMyIntfImage;
var bmph, mbmph: HBitmap;
x, y: integer;
pmask: PByte;
rawi: TRawImage;
OPBitmap: TOpBitmap;
begin
if PreserveFormat then
begin
OpBitmap := TOPBitmap.create;
OpBitmap.Assign(SourceBitmap);
end else OpBitmap := SourceBitmap;
Int := TMyIntfImage.Create(0, 0);
Int.AutoCreateMask := false;
Int.GetDescriptionFromDevice(0);
Int.Width := OpBitmap.Width;
Int.Height := OpBitmap.Height;
OpBitmap.Pixelformat := PixelFormatFromBPP(Int.DataDescription.BitsPerPixel);
for y := 0 to OpBitmap.Height - 1 do
for x := 0 to OpBitmap.Width - 1 do
Int.TColors[X, Y] := OpBitmap.Pixels[X, Y];
if OPBitmap.Transparent then
begin
int.GetRawImage(Rawi);
rawi.MaskSize := OpBitmap.GetTransparentMask(0, pmask,
Rawi.Description.AlphaBitOrder = riboReversedBits,
Rawi.Description.AlphaLineEnd = rileWordBoundary);
rawi.Mask := pmask;
{ writeln(RawImageDescriptionAsString(@Rawi));
writeln('bwid: ',OpBitmap.Width, ' bhei: ',OpBitmap.Height,' rmsiz:',Rawi.MaskSize); }
Int.CreateBitmapLateMask(bmph, mbmph, false, rawi);
end else
begin
Int.CreateBitmap(bmph, mbmph, false);
end;
Bitmap.Free;
Bitmap := TBitmap.Create;
Bitmap.Handle := bmph;
Bitmap.MaskHandle := mbmph;
Int.free;
if PreserveFormat then OPBitmap.free;
end;
procedure AssignOpBitmapToCanvas(OpBitmap: TOpBitmap; aCanvas: Graphics.TCanvas; X, Y: integer);
var Bmp: TBitmap;
begin
Bmp := TBitmap.create;
AssignOpBitmapToBitmap(OpBitmap, Bmp);
aCanvas.Draw(X, Y, bmp);
Bmp.free;
end;
{$IFNDEF VER_VTV}
{ TOPOpenDialog }
procedure TOPOpenDialog.UpdatePreview;
var
CurFilename: string;
FileIsValid: boolean;
OP: TOPPicture;
LBPP: Integer;
begin
CurFilename := FileName;
if CurFilename = FPreviewFilename then exit;
FPreviewFilename := CurFilename;
FileIsValid := FileExists(FPreviewFilename)
and (not DirPathExists(FPreviewFilename))
and FileIsReadable(FPreviewFilename);
if FileIsValid then
try
OP := TOPPicture.create;
try
OP.LoadFromFile(FPreviewFilename);
LBPP := OP.Bitmap.BPP;
OP.Bitmap.Transparent := false;
AssignOpBitmapToBitmap(Op.Bitmap, ImageCtrl.Picture.Bitmap, false);
PictureGroupBox.Caption := Format('(%dx%d BPP:%d)',
[ImageCtrl.Picture.Width, ImageCtrl.Picture.Height, LBPP]);
finally
OP.free;
end;
except
FileIsValid := False;
end;
if not FileIsValid then
ClearPreview;
end;
function TOPOpenDialog.Execute: boolean;
begin
Filter := OPGLoadFilters;
result := inherited Execute;
end;
{$ENDIF}
{ TMyIntfImage }
procedure TMyIntfImage.CreateBitmapLateMask(var Bitmap, MaskBitmap: HBitmap;
AlwaysCreateMask: boolean; const RawImage: TRawImage);
var
ARawImage: TRawImage;
begin
GetRawImage(ARawImage);
ARawImage.Mask := RawImage.Mask;
ARawImage.MaskSize := RawImage.MaskSize;
if not CreateBitmapFromRawImage(ARawImage, Bitmap, MaskBitmap, AlwaysCreateMask)
then
raise FPImageException.Create('Failed to create bitmaps');
end;
{$IFNDEF VER_VTV}
{ TLazOPPicture }
constructor TLazOPPicture.Create(Image: TImage);
begin
inherited Create;
fImage:=Image;
fUpdateImageSize:=true;
end;
procedure TLazOPPicture.DrawImage;
begin
if fImage<>nil then
begin
if fUpdateImageSize then fImage.SetBounds(0,0,Bitmap.Width,Bitmap.Height);
AssignOpBitmapToBitmap(Bitmap, fImage.Picture.Bitmap);
fImage.invalidate;
end;
end;
{$ENDIF}
end.

5813
components/virtualtreeview/vt_opbitmap.pas
View File

File diff suppressed because it is too large Load Diff