paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 09:16:13 +02:00
Code Issues Packages Projects Releases Wiki Activity

remove CreatePixmapIndirect

Browse Source 
git-svn-id: trunk@13344 -
This commit is contained in:
paul 2007-12-15 15:45:49 +00:00
parent 694ebf28a7
commit 09d6e02546
10 changed files with 1 additions and 451 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/interfaces/carbon/carbonwinapi.inc
View File

@ -430,13 +430,6 @@ begin
Result := HPEN(TCarbonPen.Create(LogPen));
end;
function TCarbonWidgetSet.CreatePixmapIndirect(const Data: Pointer;
const TransColor: Longint): HBITMAP;
begin
DebugLn('TCarbonWidgetSet.CreatePixmapIndirect TODO');
Result := 0;
end;
{------------------------------------------------------------------------------
Method: CreatePolygonRgn
Params: Points - Pointer to array of polygon points

1
lcl/interfaces/carbon/carbonwinapih.inc
View File

@ -61,7 +61,6 @@ function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
function CreatePalette(const LogPalette: TLogPalette): HPALETTE; override;
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; override;
function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; Override;
function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; override;

68
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -1991,74 +1991,6 @@ begin
Result := HPEN(PtrUInt(GObject));
end;
{------------------------------------------------------------------------------
Function: CreatePixmapIndirect
Params: Data: Raw pixmap data (PPGChar of xpm file,
You can use graphics.XPMToPPChar to create this)
Returns: Handle to LCL bitmap
Creates a bitmap from raw pixmap data.
If TransColor < 0 the transparency mask will be automatically gnerated.
------------------------------------------------------------------------------}
function TGtkWidgetSet.CreatePixmapIndirect(const Data: Pointer;
const TransColor: Longint): HBITMAP;
var
GdiObject: PGdiObject absolute Result;
GDKColor: TGDKColor;
ColorMap: PGdkColormap;
P: Pointer;
Depth : Longint;
begin
GdiObject := NewGDIObject(gdiBitmap);
if TransColor >= 0
then begin
GDKColor := AllocGDKColor(TransColor);
p := @GDKColor;
end
else p := nil; // automatically create transparency mask
{$IFDEF DebugGDKTraps}
BeginGDKErrorTrap;
{$ENDIF}
ColorMap := gdk_colormap_get_system;
try
with GdiObject^.GDIPixmapObject do
Image := gdk_pixmap_colormap_create_from_xpm_d(nil, Colormap, Mask, p, Data);
Depth := gdk_drawable_get_depth(GdiObject^.GDIPixmapObject.Image);
if (GdiObject^.Visual <> nil) and not GdiObject^.SystemVisual
then gdk_visual_unref(GdiObject^.Visual);
GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIPixmapObject.Image);
if GdiObject^.Visual = nil
then begin
GdiObject^.Visual := gdk_visual_get_best_with_depth(Depth);
if GdiObject^.Visual = nil
then GdiObject^.Visual := gdk_visual_get_system;
GdiObject^.SystemVisual := True;
end
else begin
gdk_visual_ref(GdiObject^.Visual);
GdiObject^.SystemVisual := False;
end;
if GdiObject^.Colormap <> nil
then gdk_colormap_unref(GdiObject^.Colormap);
GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, GdkFalse);
GdiObject^.GDIBitmapType := gbPixmap;
except
DisposeGDIObject(GdiObject);
GdiObject := nil;
end;
{$IFDEF DebugGDKTraps}
EndGDKErrorTrap;
{$ENDIF}
end;
{------------------------------------------------------------------------------
Method: CreatePolygonRgn
Params: Points, NumPts, FillMode

1
lcl/interfaces/gtk/gtkwinapih.inc
View File

@ -60,7 +60,6 @@ function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
function CreatePalette(const LogPalette: TLogPalette): HPALETTE; override;
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; override;
Function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; Override;
function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; override;

15
lcl/interfaces/qt/qtwinapi.inc
View File

@ -641,21 +641,6 @@ begin
Result := HPEN(QtPen);
end;
{------------------------------------------------------------------------------
Function: CreatePixmapIndirect
Params: const Data: Pointer; const TransColor: Longint
Returns: HBITMAP
------------------------------------------------------------------------------}
function TQtWidgetSet.CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP;
begin
{$ifdef VerboseQtWinAPI_MISSING_IMPLEMENTATION}
WriteLn('***** [WinAPI TQtWidgetSet.CreatePixmapIndirect] missing implementation ');
{$endif}
Result := 0;
end;
{------------------------------------------------------------------------------
Function: CreatePolygonRgn
Params: none

1
lcl/interfaces/qt/qtwinapih.inc
View File

@ -60,7 +60,6 @@ function CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN; override;
function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
function CreatePenIndirect(const LogPen: TLogPen): HBRUSH; override;
function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; override;
function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;
function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override;

341
lcl/interfaces/win32/win32winapi.inc
View File

@ -830,347 +830,6 @@ Begin
Result := Windows.CreatePenIndirect(Windows.LOGPEN(LP));
End;
{------------------------------------------------------------------------------
Method: CreatePixmapIndirect
Params: Data - Raw pixmap data
TransColor - Color of transparent spots
Returns: Handle to LCL bitmap
Creates a bitmap from raw pixmap data.
------------------------------------------------------------------------------}
function TWin32WidgetSet.CreatePixmapIndirect(const Data: Pointer; const TransColor: LongInt): HBITMAP;
begin
{$note TODO: implement default implementation on intfimage & XPM reader}
Result := inherited CreatePixmapIndirect(Data, TransColor);
end;
(*
Type
PColorMap = ^TColorMap;
TColorMap = Record
Alias: String;
Color: DWORD;
End;
PPixmapArray = ^TPixmapArray;
TPixmapArray = Array[0..1000] Of PChar;
var
CharPtr: PChar;
AliasLen : Byte;
ColorCount : Cardinal;
Height, Width : Cardinal;
S: String;
Colors: TMap;
ColorIdx: DWord;
ColorVal: DWord;
n: Integer;
AList : TList;
hdcScreen : HDC;
hdcBitmap : HDC;
hbmBitmap : HBITMAP ;
OldObject : HGDIOBJ;
PixmapArray : PPixmapArray;
Info : String;
PixmapInfo : TStringList;
procedure NormalizeString(Var Str: String);
var
S: String;
begin
Assert(False, 'Trace:NormalizeString - Start');
Str := StringReplace(Str, #9, ' ', [rfReplaceAll]);
S := '';
While True Do Begin
Str := StringReplace(Str, ' ', ' ', True);
If Str = S Then Break;
S := Str;
End;
Assert(False, 'Trace:NormalizeString - Exit');
End;
function StrToInt(Const Str: String): DWORD;
Var
S: String;
Begin
Assert(False, 'Trace:StrToInt - Start');
S := Trim(Str);
Result := SysUtils.StrToInt(S);
Assert(False, 'Trace:StrToInt - Exit');
End;
procedure CreateColorMap;
Var
Elem: String;
I, Idx: Integer;
ColorMap: PColorMap;
Begin
Assert(False, 'Trace:CreateColorMap - Start');
If ColorCount = 0 Then Begin
Assert(False, 'Trace:CreateColorMap - Color count was not retrieved; can''t create color map');
AList := Nil;
Exit;
End;
AList := TList.Create;
For I := 1 To ColorCount Do Begin
Try
Elem := String(PixmapArray^[I]);
While Pos(Elem[Length(Elem)],'",')>0 do Elem:=Copy(Elem,1,Length(Elem)-1);
Idx := Cardinal(Pos(Elem, '"'))+AliasLen+4;
New(ColorMap);
ColorMap^.Alias := Copy(Elem, 1, AliasLen);
If Copy(Elem, idx, 1) = '#' Then begin
//ColorMap^.Color := StrToInt('$'+Copy(Elem,Idx,6));
ColorMap^.Color := RGB(
Byte(StrToInt('$'+Copy(Elem,Idx+1,2))),
Byte(StrToInt('$'+Copy(Elem,Idx+3,2))),
Byte(StrToInt('$'+Copy(Elem,Idx+5,2))));
end
Else
ColorMap^.Color := TransColor;
Assert(False, Format('Trace:CreateColorMap - color-map entry info --> item: %D, data: %S, alias: %S, color:0x%X', [I, String(PixmapArray^[I]), ColorMap^.Alias, ColorMap^.Color]));
AList.Add(ColorMap);
Except
On E: Exception Do Assert(False, Format('Trace:CreateColorMap - Could not create color-map entry --> %S', [E.Message]));
End;
End;
Assert(False, 'Trace:CreateColorMap - Exit');
End;
procedure DestroyColorMap;
var
ColorMap : PColorMap;
Begin
Assert(False, 'Trace:DestroyColorMap - Start');
While AList.Count>0 do begin
ColorMap:=PColorMap(AList.Items[0]);
Dispose(ColorMap);
AList.Delete(0);
end;
If AList <> Nil Then Begin
AList.Free;
AList := Nil;
End;
Assert(False, 'Trace:DestroyColorMap - Exit');
End;
function GetColorFromAlias(Alias:String):DWORD;
var
i : Cardinal;
begin
result:=0;
i :=0;
if AList.Count>0 then begin
repeat
if (TColorMap(AList.Items[i]^).Alias=Alias) then begin
result:=TColorMap(AList.Items[i]^).Color;
break;
end;
Inc(i);
until (i>=ColorCount);
end;
end;
procedure DoDrawBitmap;
Var
CX,CY : Cardinal;
Line,Alias : String;
Begin
Assert(False, 'Trace:DoDrawBitmap - Start');
If (ColorCount = 0) Or (AList = Nil) Then
Begin
Assert(False, 'Trace:DoDrawBitmap - No information to create bitmap');
Exit;
End;
for CY:=0 to Height-1 do begin
Line:=String(PixmapArray^[1+ColorCount+CY]);
While Pos(Line[Length(Line)],'",')>0 do Line:=Copy(Line,1,Length(Line)-1);
for CX:=0 to Width-1 do begin
Alias:=Copy(Line,1+CX*AliasLen,AliasLen);
Windows.SetPixel(hdcBitmap,CX,CY,GetColorFromAlias(Alias));
end;
end;
Assert(False, 'Trace:DoDrawBitmap - Exit');
End;
function NextStart: Boolean;
var
InLineComment, // Pointer is in a line comment
InBlockComment: Boolean; // Pointer is in a block comment
begin
// moves CharPtr to the first char in a string
while CharPtr^ <> #0 do
begin
case CharPtr^ of
'/': begin
if not (InLineComment or InBlockComment)
then begin
Inc(CharPtr);
case CharPtr^ of
'/': InLineComment := True;
'*': InBlockComment := True;
else
Continue;
end;
end;
end;
'*': begin
if InBlockComment
then begin
Inc(CharPtr);
if CharPtr^ <> '/' then Continue;
InBlockComment := False;
end;
end;
#10, #13: begin
InLineComment := False;
end;
'"': begin
if not (InLineComment or InBlockComment)
then begin
Inc(CharPtr);
Result := True;
Exit;
end;
end;
end;
Inc(CharPtr);
end;
Result := False;
end;
function CopyText: String;
begin
Result := '';
while CharPtr^ <> #0 do
begin
case CharPtr^ of
'"': begin
Inc(CharPtr);
Exit;
end;
'\': begin
Inc(CharPtr);
case CharPtr^ of
'n': Result := Result + #10;
't': Result := Result + #9;
#0: Exit;
else
Result := Result + CharPtr^;
end;
end;
#10, #13:; //ignore
else
Result := Result + CharPtr^;
end;
Inc(CharPtr);
end;
end;
begin
Result := 0;
CharPtr := Data;
if not NextStart then Exit; // no strings found
S := CopyText;
if S = '' then Exit; //no pixmap definition
Width := StringToIntDef(GetPart('', ' ', S), 0);
Height := StringToIntDef(GetPart(' ', ' ', S), 0);
ColorCount := StringToIntDef(GetPart(' ', ' ', S), 0);
AliasLen := StringToIntDef(S, 0);
// fill color table
Colors := TMap.Create(itu4, 4);
for n := 1 to ColorCount do
begin
if not NextStart then Exit; // no strings found
S := CopyText;
if S = '' then Exit; //no color definition
ColorIdx := 0;
Move(S[1], ColorIdx, AliasLen);
Delete(S, 1, AliasLen);
S := GetPart('c', '', S);
while (Length(S) > 0) and (S[1] in [' ', #9]) do Delete(S, 1, 1);
if S = '' then Exit; //no color
case S[1] of
'0'..'9': ColorVal := StrToIntDef(S, TransColor);
'#': ColorVal := StrToIntDef('$'+S, TransColor);
else
case StringCase(S, [none, black, white], True, False) of
0: ColorVal := TransColor;
1: ColorVal := $00000000;
2: ColorVal := $00FFFFFF;
else
// todo: some text
ColorVal := TransColor;
end;
end;
Colors.Add(ColorIdx, ColorVal);
end;
PixmapArray := PPixmapArray(Data);
Info := String(PixmapArray^[0]);
PixmapInfo := TStringList.Create;;
NormalizeString(Info);
//My own Split:
while Pos(' ',Info)>0 do begin
PixmapInfo.Add(Copy(Info,1,Pos(' ',Info)-1)); //Add first String to list
Delete(Info,1,Pos(' ',Info)); //Delete String + Space
end;
if Length(Info)>0 then PixmapInfo.Add(Info); //Add last String;
// I don't know where this Split is defines, but it does something weired
// PixmapInfo := Split(String(PixmapArray^[0]), ' ', 3, False);
If PixmapInfo.Count = 6 Then Assert(False, 'Trace:TODO: TWin32WidgetSet.CreatePixmapIndirect - Get Pixmaps with six sections working');
Try
Width := StrToInt(PixmapInfo[0]); Assert(False, Format('Trace: Pixmap width --> %D', [Width]));
Height := StrToInt(PixmapInfo[1]); Assert(False, Format('Trace: Pixmap height --> %D', [Height]));
ColorCount := StrToInt(PixmapInfo[2]); Assert(False, Format('Trace: number of colors --> %D', [ColorCount]));
While Pos(PixmapInfo[3][Length(PixmapInfo[3])],'",')>0 do
PixmapInfo[3]:=Copy(PixmapInfo[3],1,Length(PixMapInfo[3])-1);
AliasLen := StrToInt(PixmapInfo[3]);
Assert(False, Format('Trace: characters per pixel --> %D', [AliasLen]));
Assert(False, Format('Trace:TWin32WidgetSet.CreatePixmapIndirect - Pixmap info: Width - %D; Height - %D; Number of Colors - %D; Characters per pixel - %D; Transparent color - 0x%X', [Width, Height, ColorCount, AliasLen, TransColor]));
Except
On E: Exception Do
Begin
Assert(False, 'Trace:Error: TWin32WidgetSet.CreatePixmapIndirect - could not retrieve pixmap info --> ' + E.Message);
End;
End;
If (Width <> 0) And (Height <> 0) Then Begin
hdcScreen := Windows.GetDC(GetDesktopWindow);
hdcBitmap := CreateCompatibleDC(hdcScreen);
hbmBitmap := CreateCompatibleBitmap(hdcScreen, Width, Height);
OldObject := SelectObject(hdcBitmap, hbmBitmap);
CreateColorMap;
DoDrawBitmap;
DestroyColorMap;
ReleaseDC(GetDesktopWindow, hdcScreen);
SelectObject(hdcBitmap, OldObject);
DeleteDC(hdcBitmap);
Result:=hbmBitmap;
end;
PixmapInfo.Free;
PixmapInfo := Nil;
PixmapArray := Nil;
Assert(False, 'Trace:TWin32WidgetSet.CreatePixmapIndirect - Exit');
End;
*)
{------------------------------------------------------------------------------
Method: CreatePolygonRgn
Params: Points, NumPts, FillMode

2
lcl/interfaces/win32/win32winapih.inc
View File

@ -57,8 +57,6 @@ function CreateDIBSection(DC: HDC; const p2: tagBitmapInfo; p3: UINT;
function CreateFontIndirect(Const LogFont: TLogFont): HFONT; override;
function CreatePatternBrush(ABitmap: HBITMAP): HBRUSH; override;
function CreatePenIndirect(Const LogPen: TLogPen): HPEN; override;
{ Creates a bitmap from raw pixmap data }
function CreatePixmapIndirect(Const Data: Pointer; Const TransColor: LongInt): HBITMAP; override;
function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;
function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN; override;

13
lcl/interfaces/wince/wincewinapi.inc
View File

@ -616,19 +616,6 @@ Begin
Result := Windows.CreatePenIndirect(Windows.LOGPEN(LP));
End;
{------------------------------------------------------------------------------
Method: CreatePixmapIndirect
Params: Data - Raw pixmap data
TransColor - Color of transparent spots
Returns: Handle to LCL bitmap
Creates a bitmap from raw pixmap data.
------------------------------------------------------------------------------}
{function TWinCEWidgetSet.CreatePixmapIndirect(const Data: Pointer;
const TransColor: Longint): HBITMAP;
begin
Result:=inherited CreatePixmapIndirect(Data, TransColor);
end;}
{------------------------------------------------------------------------------
Method: CreatePolygonRgn
Params: Points, NumPts, FillMode

3
lcl/interfaces/wince/wincewinapih.inc
View File

@ -76,8 +76,7 @@ function CreateFontIndirect(const LogFont: TLogFont): HFONT; override;
//function CreateFontIndirectEx(const LogFont: TLogFont; const LongFontName: string): HFONT; override;
//function CreatePalette(const LogPalette: TLogPalette): HPALETTE; override;
function CreatePenIndirect(const LogPen: TLogPen): HPEN; override;
{function CreatePixmapIndirect(const Data: Pointer; const TransColor: Longint): HBITMAP; override;
Function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; Override;}
//function CreatePolygonRgn(Points: PPoint; NumPts: Integer; FillMode: integer): HRGN; override;
function CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN; override;
{procedure DeleteCriticalSection(var CritSection: TCriticalSection); override;}