From bc71030c0a8bae03057418cd8e2069f9da9a0ee5 Mon Sep 17 00:00:00 2001 From: lazarus Date: Tue, 29 Jan 2002 18:55:27 +0000 Subject: [PATCH] Keith: Fixed duplicate compiler options on Win32 git-svn-id: trunk@644 - --- Makefile | 16 ++- Makefile.fpc | 12 +-- ide/lazarus.pp | 5 +- lcl/interfaces/win32/win32winapi.inc | 141 +++++++++++++++++++++++++-- lcl/interfaces/win32/winext.pas | 23 ++++- 5 files changed, 172 insertions(+), 25 deletions(-) diff --git a/Makefile b/Makefile index 060392b8e9..0517eee090 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ # -# Don't edit, this file is generated by FPCMake Version 1.1 [2001/12/31] +# Don't edit, this file is generated by FPCMake Version 1.1 [2001/12/19] # default: all override PATH:=$(subst \,/,$(PATH)) @@ -156,8 +156,6 @@ override PACKAGE_VERSION=0.8a ifndef LCL_PLATFORM ifeq ($(OS_TARGET), win32) LCL_PLATFORM=win32 -override FPCOPT+=-dSUPPORTS_RESOURCES -export FPCOPT else LCL_PLATFORM=gtk endif @@ -1354,7 +1352,7 @@ fpc_info: @$(ECHO) Ld........ $(LD) @$(ECHO) Ar........ $(AR) @$(ECHO) Rc........ $(RC) - @$(ECHO) + @$(ECHO) @$(ECHO) Mv........ $(MVPROG) @$(ECHO) Cp........ $(CPPROG) @$(ECHO) Rm........ $(RMPROG) @@ -1544,7 +1542,7 @@ endif %.res: %.rc windres -i $< -o $@ ide: -ifeq ($(LCL_PLATFORM), win32) +ifeq ($(OS_TARGET), win32) $(MAKE) lazarus.res endif $(MAKE) --assume-new=lazarus.pp lazarus$(EXEEXT) @@ -1552,10 +1550,10 @@ tools: lcl components tools_all all: lcl components ide clean: cleanall $(DEL) $(wildcard ./designer/*$(OEXT)) - $(DEL) $(wildcard ./designer/*$(PPUEXT)) - $(DEL) $(wildcard ./debugger/*$(OEXT)) - $(DEL) $(wildcard ./debugger/*$(PPUEXT)) -ifeq ($(LCL_PLATFORM), win32) + $(wildcard ./designer/*$(PPUEXT)) + $(wildcard ./debugger/*$(OEXT)) + $(wildcard ./debugger/*$(PPUEXT)) +ifeq ($(OS_TARGET), win32) $(DEL) $(wildcard *.res) $(DEL) lazarus.owr endif diff --git a/Makefile.fpc b/Makefile.fpc index d557f64754..1132973a61 100644 --- a/Makefile.fpc +++ b/Makefile.fpc @@ -33,8 +33,6 @@ destdir=$(BASEDIR)/dist ifndef LCL_PLATFORM ifeq ($(OS_TARGET), win32) LCL_PLATFORM=win32 -override FPCOPT+=-dSUPPORTS_RESOURCES -export FPCOPT else LCL_PLATFORM=gtk endif @@ -49,7 +47,7 @@ endif windres -i $< -o $@ ide: -ifeq ($(LCL_PLATFORM), win32) +ifeq ($(OS_TARGET), win32) $(MAKE) lazarus.res endif $(MAKE) --assume-new=lazarus.pp lazarus$(EXEEXT) @@ -60,10 +58,10 @@ all: lcl components ide clean: cleanall $(DEL) $(wildcard ./designer/*$(OEXT)) - $(DEL) $(wildcard ./designer/*$(PPUEXT)) - $(DEL) $(wildcard ./debugger/*$(OEXT)) - $(DEL) $(wildcard ./debugger/*$(PPUEXT)) -ifeq ($(LCL_PLATFORM), win32) + $(wildcard ./designer/*$(PPUEXT)) + $(wildcard ./debugger/*$(OEXT)) + $(wildcard ./debugger/*$(PPUEXT)) +ifeq ($(OS_TARGET), win32) $(DEL) $(wildcard *.res) $(DEL) lazarus.owr endif diff --git a/ide/lazarus.pp b/ide/lazarus.pp index ee6304086f..a9da8c5d3c 100644 --- a/ide/lazarus.pp +++ b/ide/lazarus.pp @@ -26,7 +26,7 @@ program lazarus; {$I ide.inc} -{$IFDEF SUPPORTS_RESOURCES} +{$IFDEF WIN32} {$R *.res} {$ENDIF} @@ -70,6 +70,9 @@ end. { $Log$ + Revision 1.27 2002/01/29 18:55:27 lazarus + Keith: Fixed duplicate compiler options on Win32 + Revision 1.26 2001/12/11 16:51:36 lazarus Modified the Watches dialog Shane diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index cd343acdf4..90fbf980e1 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -370,9 +370,10 @@ Type PColorArray = ^TColorArray; TColorArray = Array[0..1] Of TColorMap; PPixmapArray = ^TPixmapArray; - TPixmapArray = Array[0..1] Of PChar; + TPixmapArray = Array[0..1000] Of PChar; Var AliasLen, BitCount, C, Planes: Cardinal; + AList: TList; Bits: PBitData; ColorArray: PColorArray; ColorCount: Integer; @@ -386,36 +387,159 @@ Var PixmapInfo: TStringList; Const DC_SCREEN = 0; + + Procedure NormalizeString(Var Str: String); + Var + S: String; + Const + keyTab = #9; + Begin + Assert(False, 'Trace:NormalizeString - Start'); + Str := Replace(Str, keyTab, ' ', True); + S := ''; + + While True Do + Begin + Str := Replace(Str, ' ', ' ', True); + If Str = S Then + Break; + S := Str; + End; + Assert(False, 'Trace:NormalizeString - Exit'); + End; + + Function StrToInt(Const Str: String): Integer; + Var + S: String; + Begin + Assert(False, 'Trace:StrToInt - Start'); + S := Trim(Str); + Result := SysUtils.StrToInt(S); + Assert(False, 'Trace:StrToInt - Exit'); + End; + + Function CreateColorMap: PColorArray; + Var + Elem: String; + I: Integer; + Idx: Cardinal; + ColorMap: TColorMap; + 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; + Result := Nil; + Exit; + End; + + AList := TList.Create; + For I := 1 To ColorCount Do + Begin + Try + Elem := String(PixmapArray^[I]); + Idx := Length(Elem) - 6; + With ColorMap Do + Begin + Alias := Copy(Elem, 1, AliasLen); + If Copy(Elem, Length(Elem) - 5, 4) <> 'None' Then + Color := StrToInt('$' + Copy(Elem, Idx, Length(Elem) - Idx - 1)) + Else + Color := TransColor; + Assert(False, Format('Trace:CreateColorMap - color-map entry info --> item: %D, data: %S, alias: %S, color:0x%X', [I, String(PixmapArray^[I]), Alias, Color])); + End; + AList.Add(@ColorMap); + Except + On E: Exception Do + Assert(False, Format('Trace:CreateColorMap - Could not create color-map entry --> %S', [E.Message])); + End; + End; + + TList(Result) := AList; + Assert(False, 'Trace:CreateColorMap - Exit'); + End; + + Procedure DestroyColorMap(ColorMap: PColorArray); + Begin + Assert(False, 'Trace:DestroyColorMap - Start'); + If ColorMap <> Nil Then + ColorMap := Nil; + + If AList <> Nil Then + Begin + AList.Free; + AList := Nil; + End; + + Assert(False, 'Trace:DestroyColorMap - Exit'); + End; + + Procedure DoDrawBitmap; + Var + CX, CY: Cardinal; + 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; + + Assert(False, 'Trace:DoDrawBitmap - TODO: Draw the bitmap'); + Assert(False, 'Trace:DoDrawBitmap - Exit'); + End; Begin Assert(False, 'Trace:TWin32Object.CreatePixmapIndirect - Start'); + + Height := 0; + Width := 0; + ColorCount := 0; + AliasLen := 0; + Result := HBITMAP(Nil); + PixmapArray := PPixmapArray(Data); + NormalizeString(String(PixmapArray^[0])); PixmapInfo := Split(String(PixmapArray^[0]), ' ', 3, False); If PixmapInfo.Count = 6 Then Assert(False, 'Trace:TODO: TWin32Object.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]); - AliasLen := StrToInt(Copy(PixmapInfo[3], 1, Length(PixMapInfo[3]) - 1)); + Assert(False, Format('Trace: number of colors --> %D', [ColorCount])); + If PixmapInfo[3][Length(PixmapInfo[3])] = '"' Then + 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:TWin32Object.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: TWin32Object.CreatePixmapIndirect - could not retrieve pixmap info --> ' + E.Message); - Result := HBITMAP(Nil); - Exit; End; End; + // Temp values //Width := 100; //Height := 100; DC := CreateCompatibleDC(DC_SCREEN); - Result := CreateCompatibleBitmap(DC, Width, Height); + If (Width <> 0) And (Height <> 0) Then + Result := CreateCompatibleBitmap(DC, Width, Height); OldObject := SelectObject(DC, Result); - Assert(False, 'Trace:TODO: TWin32Object.CreatePixmapIndirect - Set the color info of the bitmap'); - SelectObject(DC, OldObject); + //GetMem(PixmapArray, (Width + ColorCount) * SizeOf(PChar)); + ColorArray := CreateColorMap; + DoDrawBitmap; + DestroyColorMap(ColorArray); + //FreeMem(PixmapArray); PixmapInfo.Free; PixmapInfo := Nil; + PixmapArray := Nil; + SelectObject(DC, OldObject); DeleteDC(DC); Assert(False, 'Trace:TWin32Object.CreatePixmapIndirect - Exit'); End; @@ -1708,6 +1832,9 @@ End; { ============================================================================= $Log$ + Revision 1.5 2002/01/29 18:55:27 lazarus + Keith: Fixed duplicate compiler options on Win32 + Revision 1.4 2002/01/21 09:04:30 lazarus Keith: Removed redef of Assert diff --git a/lcl/interfaces/win32/winext.pas b/lcl/interfaces/win32/winext.pas index 9993056391..fb6723f5ee 100644 --- a/lcl/interfaces/win32/winext.pas +++ b/lcl/interfaces/win32/winext.pas @@ -83,6 +83,9 @@ Function GetComboBoxInfo(Const hwndCombo: HWND; pcbi: PCOMBOBOXINFO): BOOL; StdC { Convert string Str to a PChar } Function StrToPChar(Const Str: String): PChar; +{ Replace OrigStr with ReplStr in Str } +Function Replace(Const Str, OrigStr, ReplStr: String; Const Global: Boolean): String; + { Creates a string list limited to Count (-1 for no limit) entries by splitting Str into substrings around SplitStr } Function Split(Const Str: String; SplitStr: String; Count: Integer; Const CaseSensitive: Boolean): TStringList; @@ -107,6 +110,24 @@ Begin Result := TmpStr; End; +Function Replace(Const Str, OrigStr, ReplStr: String; Const Global: Boolean): String; +Var + InsPt: Byte; +Begin + Result := Str; + Repeat + InsPt := Pos(OrigStr, Result); + If InsPt <> 0 Then + Begin + Delete(Result, InsPt, Length(OrigStr)); + Insert(ReplStr, Result, InsPt); + End; + + If Not Global Then + Break; + Until InsPt = 0; +End; + Function Split(Const Str: String; SplitStr: String; Count: Integer; Const CaseSensitive: Boolean): TStringList; Var LastP, P: Byte; @@ -187,4 +208,4 @@ Except Assert(False, Format('Trace:Could not deallocate string --> %S', [E.Message])); End; -End. \ No newline at end of file +End.